]> code.delx.au - gnu-emacs-elpa/blobdiff - yasnippet.el
Merge pull request #621 from npostavs/dfs-extra-modes2
[gnu-emacs-elpa] / yasnippet.el
index 15b9defb3b6430fa1d3754512a4858ad8a1c0f1e..a11901117bc1c1578acc47c6808445bd54322c9d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; yasnippet.el --- Yet another snippet extension for Emacs.
 
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2013, 2015 Free Software Foundation, Inc.
 ;; Authors: pluskid <pluskid@gmail.com>,  João Távora <joaotavora@gmail.com>
 ;; Maintainer: João Távora <joaotavora@gmail.com>
 ;; Version: 0.8.1
@@ -41,7 +41,7 @@
 ;;           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
+;;           the list override other dir's snippets.  Also, the first
 ;;           directory is taken as the default for storing the user's
 ;;           new snippets.
 ;;
@@ -165,7 +165,7 @@ 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'
+Elements appearing earlier in the list override later elements'
 snippets.
 
 The first directory is taken as the default for storing snippet's
@@ -526,10 +526,6 @@ snippet itself contains a condition that returns the symbol
 (defvar yas--menu-table (make-hash-table)
   "A hash table of MAJOR-MODE symbols to menu keymaps.")
 
-(defvar yas--known-modes
-  '(ruby-mode rst-mode markdown-mode)
-  "A list of mode which is well known but not part of Emacs.")
-
 (defvar yas--escaped-characters
   '(?\\ ?` ?\" ?' ?$ ?} ?{ ?\( ?\))
   "List of characters which *might* need to be escaped.")
@@ -729,23 +725,25 @@ defined direct keybindings to the command
                      yas--direct-keymaps))
            yas--tables))
 
-(defun yas--modes-to-activate ()
+(defun yas--modes-to-activate (&optional mode)
   "Compute list of mode symbols that are active for `yas-expand'
 and friends."
-  (let (dfs)
-    (setq dfs (lambda (mode &optional explored)
-                (push mode explored)
-                (cons mode
-                      (loop for neighbour
-                            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)))))
+  (let (dfs explored)
+    (setq dfs (lambda (mode)
+                (unless (memq mode explored)
+                  (push mode explored)
+                  (loop for neighbour
+                        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))
+                        do (funcall dfs neighbour)))))
+    (if mode
+        (funcall dfs mode)
+      (mapcar dfs (cons major-mode yas--extra-modes)))
+    explored))
 
 (defvar yas-minor-mode-hook nil
   "Hook run when `yas-minor-mode' is turned on.")
@@ -916,14 +914,39 @@ Honour `yas-dont-activate', which see."
 \f
 ;;; Internal structs for template management
 
-(defstruct (yas--template (:constructor yas--make-blank-template))
+(cl-defstruct (yas--template
+               (:constructor yas--make-template)
+               ;; Handles `yas-define-snippets' format, plus the
+               ;; initial TABLE argument.
+               (:constructor
+                yas--define-snippets-2
+                (table
+                 key content
+                 &optional xname condition group
+                 expand-env load-file xkeybinding xuuid save-file
+                 &aux
+                 (name (or xname
+                           ;; A little redundant: we always get a name
+                           ;; from `yas--parse-template' except when
+                           ;; there isn't a file.
+                           (and load-file (file-name-nondirectory load-file))
+                           (and save-file (file-name-nondirectory save-file))
+                           key))
+                 (keybinding (yas--read-keybinding xkeybinding))
+                 (uuid (or xuuid name))
+                 (old (gethash uuid (yas--table-uuidhash table)))
+                 (menu-binding-pair
+                  (and old (yas--template-menu-binding-pair old)))
+                 (perm-group
+                  (and old (yas--template-perm-group old))))))
   "A template for a snippet."
   key
   content
   name
   condition
   expand-env
-  file
+  load-file
+  save-file
   keybinding
   uuid
   menu-binding-pair
@@ -932,16 +955,6 @@ Honour `yas-dont-activate', which see."
   table
   )
 
-(defun yas--populate-template (template &rest args)
-  "Helper function to populate TEMPLATE with properties."
-  (while args
-    (aset template
-          (position (intern (substring (symbol-name (car args)) 1))
-                    (mapcar #'car (get 'yas--template 'cl-struct-slots)))
-          (second args))
-    (setq args (cddr args)))
-  template)
-
 (defstruct (yas--table (:constructor yas--make-snippet-table (name)))
   "A table to store snippets for a particular mode.
 
@@ -1093,7 +1106,8 @@ keybinding)."
 (defun yas--update-template (table template)
   "Add or update TEMPLATE in TABLE.
 
-Also takes care of adding and updating to the associated menu."
+Also takes care of adding and updating to the associated menu.
+Return TEMPLATE."
   ;; Remove from table by uuid
   ;;
   (yas--remove-template-by-uuid table (yas--template-uuid template))
@@ -1102,7 +1116,8 @@ Also takes care of adding and updating to the associated menu."
   (yas--add-template table template)
   ;; Take care of the menu
   ;;
-  (yas--update-template-menu table template))
+  (yas--update-template-menu table template)
+  template)
 
 (defun yas--update-template-menu (table template)
   "Update every menu-related for TEMPLATE."
@@ -1257,7 +1272,8 @@ Returns (TEMPLATES START END). This function respects
                            'again)
                  (setq methods (cdr methods))))
               (t
-               (yas--warning "Warning invalid element %s in `yas-key-syntaxes'" method)))
+               (setq methods (cdr methods))
+               (yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method)))
         (let ((possible-key (buffer-substring-no-properties (point) original)))
           (save-excursion
             (goto-char original)
@@ -1283,16 +1299,6 @@ Returns (TEMPLATES START END). This function respects
 \f
 ;;; Internal functions and macros:
 
-(defun yas--real-mode? (mode)
-  "Try to find out if MODE is a real mode.
-
-The MODE bound to a function (like `c-mode') is considered real
-mode.  Other well known mode like `ruby-mode' which is not part of
-Emacs might not bound to a function until it is loaded.  So
-yasnippet keeps a list of modes like this to help the judgment."
-  (or (fboundp mode)
-      (find mode yas--known-modes)))
-
 (defun yas--handle-error (err)
   "Handle error depending on value of `yas-good-grace'."
   (let ((msg (yas--format "elisp error: %s" (error-message-string err))))
@@ -1357,15 +1363,17 @@ return an expression that when evaluated will issue an error."
             yas--direct-keymaps))
     table))
 
-(defun yas--get-snippet-tables ()
-  "Get snippet tables for current buffer.
+(defun yas--get-snippet-tables (&optional mode)
+  "Get snippet tables for MODE.
+
+MODE defaults to the current buffer's `major-mode'.
 
 Return a list of `yas--table' objects.  The list of modes to
 consider is returned by `yas--modes-to-activate'"
   (remove nil
           (mapcar #'(lambda (name)
                       (gethash name yas--tables))
-                  (yas--modes-to-activate))))
+                  (yas--modes-to-activate mode))))
 
 (defun yas--menu-keymap-get-create (mode &optional parents)
   "Get or create the menu keymap for MODE and its PARENTS.
@@ -1404,7 +1412,7 @@ otherwise we attempt to calculate it from FILE.
 
 Return a snippet-definition, i.e. a list
 
- (KEY TEMPLATE NAME CONDITION GROUP VARS FILE KEYBINDING UUID)
+ (KEY TEMPLATE NAME CONDITION GROUP VARS LOAD-FILE KEYBINDING UUID)
 
 If the buffer contains a line of \"# --\" then the contents above
 this line are ignored. Directives can set most of these with the syntax:
@@ -1620,43 +1628,10 @@ Optional PROMPT sets the prompt to use."
 
 (defun yas--define-snippets-1 (snippet snippet-table)
   "Helper for `yas-define-snippets'."
-  ;; X) Calculate some more defaults on the values returned by
-  ;; `yas--parse-template'.
-  ;;
-  (let* ((file (seventh snippet))
-         (key (car snippet))
-         (name (or (third snippet)
-                   (and file
-                        (file-name-directory file))))
-         (condition (fourth snippet))
-         (group (fifth snippet))
-         (keybinding (yas--read-keybinding (eighth snippet)))
-         (uuid (or (ninth snippet)
-                  name))
-         (template (or (gethash uuid (yas--table-uuidhash snippet-table))
-                       (yas--make-blank-template))))
-    ;; X) populate the template object
-    ;;
-    (yas--populate-template template
-                           :table       snippet-table
-                           :key         key
-                           :content     (second snippet)
-                           :name        (or name key)
-                           :group       group
-                           :condition   condition
-                           :expand-env  (sixth snippet)
-                           :file        (seventh snippet)
-                           :keybinding  keybinding
-                           :uuid         uuid)
-    ;; X) Update this template in the appropriate table. This step
-    ;;    also will take care of adding the key indicators in the
-    ;;    templates menu entry, if any
-    ;;
-    (yas--update-template snippet-table template)
-    ;; X) Return the template
-    ;;
-    ;;
-    template))
+  ;; Update the appropriate table.  Also takes care of adding the
+  ;; key indicators in the templates menu entry, if any.
+  (yas--update-template
+   snippet-table (apply #'yas--define-snippets-2 snippet-table snippet)))
 
 (defun yas-define-snippets (mode snippets)
   "Define SNIPPETS for MODE.
@@ -1664,7 +1639,7 @@ Optional PROMPT sets the prompt to use."
 SNIPPETS is a list of snippet definitions, each taking the
 following form
 
- (KEY TEMPLATE NAME CONDITION GROUP EXPAND-ENV FILE KEYBINDING UUID)
+ (KEY TEMPLATE NAME CONDITION GROUP EXPAND-ENV LOAD-FILE KEYBINDING UUID SAVE-FILE)
 
 Within these, only KEY and TEMPLATE are actually mandatory.
 
@@ -1686,33 +1661,19 @@ file with the same uuid would replace the previous snippet.
 You can use `yas--parse-template' to return such lists based on
 the current buffers contents."
   (if yas--creating-compiled-snippets
-      (progn
+      (let ((print-length nil))
         (insert ";;; Snippet definitions:\n;;;\n")
-        (let ((literal-snippets (list))
-              (print-length nil))
-          (dolist (snippet snippets)
-            (let ((key                    (nth 0 snippet))
-                  (template-content       (nth 1 snippet))
-                  (name                   (nth 2 snippet))
-                  (condition              (nth 3 snippet))
-                  (group                  (nth 4 snippet))
-                  (expand-env             (nth 5 snippet))
-                  (file                   nil) ;; omit on purpose
-                  (binding                (nth 7 snippet))
-                  (uuid                   (nth 8 snippet)))
-              (push `(,key
-                      ,template-content
-                      ,name
-                      ,condition
-                      ,group
-                      ,expand-env
-                      ,file
-                      ,binding
-                      ,uuid)
-                    literal-snippets)))
-          (insert (pp-to-string
-                   `(yas-define-snippets ',mode ',literal-snippets)))
-          (insert "\n\n")))
+        (dolist (snippet snippets)
+          ;; Fill in missing elements with nil.
+          (setq snippet (append snippet (make-list (- 10 (length snippet)) nil)))
+          ;; Move LOAD-FILE to SAVE-FILE because we will load from the
+          ;; compiled file, not LOAD-FILE.
+          (let ((load-file (nth 6 snippet)))
+            (setcar (nthcdr 6 snippet) nil)
+            (setcar (nthcdr 9 snippet) load-file)))
+        (insert (pp-to-string
+                 `(yas-define-snippets ',mode ',snippets)))
+        (insert "\n\n"))
     ;; Normal case.
     (let ((snippet-table (yas--table-get-create mode))
           (template nil))
@@ -1724,13 +1685,22 @@ the current buffers contents."
 \f
 ;;; Loading snippets from files
 
+(defun yas--template-get-file (template)
+  "Return TEMPLATE's LOAD-FILE or SAVE-FILE."
+  (or (yas--template-load-file template)
+      (let ((file (yas--template-save-file template)))
+        (when file
+          (yas--message 2 "%s has no load file, use save file, %s, instead."
+                        (yas--template-name template) file))
+        file)))
+
 (defun yas--load-yas-setup-file (file)
   (if (not yas--creating-compiled-snippets)
       ;; Normal case.
-      (load file 'noerror)
+      (load file 'noerror (<= yas-verbosity 2))
     (let ((elfile (concat file ".el")))
       (when (file-exists-p elfile)
-        (insert ";;; .yas-setup.el support file if any:\n;;;\n")
+        (insert ";;; contents of the .yas-setup.el support file:\n;;;\n")
         (insert-file-contents elfile)
         (goto-char (point-max))))))
 
@@ -1941,10 +1911,6 @@ foo\"bar\\! -> \"foo\\\"bar\\\\!\""
 \f
 ;;; Snippet compilation function
 
-(defun yas--initialize ()
-  "For backward compatibility, enable `yas-minor-mode' globally."
-  (yas-global-mode 1))
-
 (defun yas-compile-directory (top-level-dir)
   "Create .yas-compiled-snippets.el files under subdirs of TOP-LEVEL-DIR.
 
@@ -2089,11 +2055,10 @@ omitted from MODE's menu, even if they're manually loaded."
                         hash)
     (dolist (uuid omit-items)
       (let ((template (or (gethash uuid hash)
-                          (yas--populate-template (puthash uuid
-                                                           (yas--make-blank-template)
-                                                           hash)
-                                                  :table table
-                                                  :uuid uuid))))
+                          (puthash uuid
+                                   (yas--make-template :table table
+                                                       :uuid uuid)
+                                   hash))))
         (setf (yas--template-menu-binding-pair template) (cons nil :none))))))
 
 (defun yas--define-menu-1 (table menu-keymap menu uuidhash &optional group-list)
@@ -2101,12 +2066,12 @@ omitted from MODE's menu, even if they're manually loaded."
   (dolist (e (reverse menu))
     (cond ((eq (first e) 'yas-item)
            (let ((template (or (gethash (second e) uuidhash)
-                               (yas--populate-template (puthash (second e)
-                                                               (yas--make-blank-template)
-                                                               uuidhash)
-                                                      :table table
-                                                      :perm-group group-list
-                                                      :uuid (second e)))))
+                               (puthash (second e)
+                                        (yas--make-template
+                                         :table table
+                                         :perm-group group-list
+                                         :uuid (second e))
+                                        uuidhash))))
              (define-key menu-keymap (vector (gensym))
                (car (yas--template-menu-binding-pair-get-create template :stay)))))
           ((eq (first e) 'yas-submenu)
@@ -2335,6 +2300,28 @@ Honours `yas-choose-tables-first', `yas-choose-keys-first' and
             (remove-duplicates (mapcan #'yas--table-templates tables)
                                :test #'equal))))
 
+(defun yas--lookup-snippet-1 (name mode)
+  "Get the snippet called NAME in MODE's tables."
+  (let ((yas-choose-tables-first nil)   ; avoid prompts
+        (yas-choose-keys-first nil))
+    (cl-find name (yas--all-templates
+                   (yas--get-snippet-tables mode))
+             :key #'yas--template-name :test #'string=)))
+
+(defun yas-lookup-snippet (name &optional mode noerror)
+  "Get the snippet content for the snippet NAME in MODE's tables.
+
+MODE defaults to the current buffer's `major-mode'.  If NOERROR
+is non-nil, then don't signal an error if there isn't any snippet
+called NAME.
+
+Honours `yas-buffer-local-condition'."
+  (let ((snippet (yas--lookup-snippet-1 name mode)))
+    (cond
+     (snippet (yas--template-content snippet))
+     (noerror nil)
+     (t (error "No snippet named: %s" name)))))
+
 (defun yas-insert-snippet (&optional no-condition)
   "Choose a snippet to expand, pop-up a list of choices according
 to `yas-prompt-functions'.
@@ -2381,7 +2368,7 @@ visited file in `snippet-mode'."
 
 (defun yas--visit-snippet-file-1 (template)
   "Helper for `yas-visit-snippet-file'."
-  (let ((file (yas--template-file template)))
+  (let ((file (yas--template-get-file template)))
     (cond ((and file (file-readable-p file))
            (find-file-other-window file)
            (snippet-mode)
@@ -2555,7 +2542,7 @@ When called interactively, prompt for the table name."
    ;;  template which is already loaded and neatly positioned,...
    ;;
    (yas--editing-template
-    (yas--define-snippets-1 (yas--parse-template (yas--template-file yas--editing-template))
+    (yas--define-snippets-1 (yas--parse-template (yas--template-load-file yas--editing-template))
                            (yas--template-table yas--editing-template)))
    ;; Try to use `yas--guessed-modes'. If we don't have that use the
    ;; value from `yas--compute-major-mode-and-parents'
@@ -2585,29 +2572,27 @@ Don't use this from a Lisp program, call `yas-load-snippet-buffer'
 and `kill-buffer' instead."
   (interactive (list (yas--read-table) current-prefix-arg))
   (yas-load-snippet-buffer table t)
-  (when (and (or
-              ;; Only offer to save this if it looks like a library or new
-              ;; snippet (loaded from elisp, from a dir in `yas-snippet-dirs'
-              ;; which is not the first, or from an unwritable file)
-              ;;
-              (not (yas--template-file yas--editing-template))
-              (not (file-writable-p (yas--template-file yas--editing-template)))
-              (and (listp yas-snippet-dirs)
-                   (second yas-snippet-dirs)
-                   (not (string-match (expand-file-name (first yas-snippet-dirs))
-                                      (yas--template-file yas--editing-template)))))
-             (y-or-n-p (yas--format "Looks like a library or new snippet. Save to new file? ")))
-    (let* ((option (first (yas--guess-snippet-directories (yas--template-table yas--editing-template))))
-           (chosen (and option
-                        (yas--make-directory-maybe option))))
-      (when chosen
-        (let ((default-file-name (or (and (yas--template-file yas--editing-template)
-                                          (file-name-nondirectory (yas--template-file yas--editing-template)))
-                                     (yas--template-name yas--editing-template))))
-          (write-file (concat chosen "/"
-                              (read-from-minibuffer (format "File name to create in %s? " chosen)
-                                                    default-file-name)))
-          (setf (yas--template-file yas--editing-template) buffer-file-name)))))
+  (let ((file (yas--template-get-file yas--editing-template)))
+    (when (and (or
+                ;; Only offer to save this if it looks like a library or new
+                ;; snippet (loaded from elisp, from a dir in `yas-snippet-dirs'
+                ;; which is not the first, or from an unwritable file)
+                ;;
+                (not file)
+                (not (file-writable-p file))
+                (and (cdr-safe yas-snippet-dirs)
+                     (not (string-prefix-p (expand-file-name (car yas-snippet-dirs)) file))))
+               (y-or-n-p (yas--format "Looks like a library or new snippet. Save to new file? ")))
+      (let* ((option (first (yas--guess-snippet-directories (yas--template-table yas--editing-template))))
+             (chosen (and option
+                          (yas--make-directory-maybe option))))
+        (when chosen
+          (let ((default-file-name (or (and file (file-name-nondirectory file))
+                                       (yas--template-name yas--editing-template))))
+            (write-file (concat chosen "/"
+                                (read-from-minibuffer (format "File name to create in %s? " chosen)
+                                                      default-file-name)))
+            (setf (yas--template-load-file yas--editing-template) buffer-file-name))))))
   (when buffer-file-name
     (save-buffer)
     (quit-window kill)))
@@ -2625,12 +2610,11 @@ and `kill-buffer' instead."
          (yas--current-template
           (and parsed
                (fboundp test-mode)
-               (yas--populate-template (yas--make-blank-template)
-                                      :table       nil ;; no tables for ephemeral snippets
-                                      :key         (first parsed)
-                                      :content     (second parsed)
-                                      :name        (third parsed)
-                                      :expand-env  (sixth parsed)))))
+               (yas--make-template :table       nil ;; no tables for ephemeral snippets
+                                   :key         (first parsed)
+                                   :content     (second parsed)
+                                   :name        (third parsed)
+                                   :expand-env  (sixth parsed)))))
     (cond (yas--current-template
            (let ((buffer-name (format "*testing snippet: %s*" (yas--template-name yas--current-template))))
              (kill-buffer (get-buffer-create buffer-name))
@@ -3047,7 +3031,8 @@ through the field's start point"
    ;; the field numbered 0, just before the exit marker, should
    ;; never be skipped
    ;;
-   (not (zerop (yas--field-number field)))))
+   (not (and (yas--field-number field)
+             (zerop (yas--field-number field))))))
 
 (defun yas--snippets-at-point (&optional all-snippets)
   "Return a sorted list of snippets at point.
@@ -3518,8 +3503,12 @@ The error should be ignored in `debug-ignored-errors'"
   "Expand snippet CONTENT at current point.
 
 Text between START and END will be deleted before inserting
-template.  EXPAND-ENV is are let-style variable to value bindings
+template.  EXPAND-ENV is a list of (SYM VALUE) let-style dynamic bindings
 considered when expanding the snippet."
+  (cl-assert (and yas-minor-mode
+                  (memq 'yas--post-command-handler post-command-hook))
+             nil
+             "[yas] `yas-expand-snippet' needs properly setup `yas-minor-mode'")
   (run-hooks 'yas-before-expand-snippet-hook)
 
   ;;
@@ -4318,7 +4307,7 @@ When multiple expressions are found, only the last one counts."
                    (or (and fallback
                             (format "call command `%s'."
                                     (pp-to-string fallback)))
-                       "do nothing (`yas-expand' doesn't shadow\nanything).")))
+                       "do nothing (`yas-expand' doesn't override\nanything).")))
                 ((eq yas-fallback-behavior 'return-nil)
                  "do nothing.")
                 (t "defer to `yas-fallback-behavior' (which see)."))))
@@ -4458,6 +4447,11 @@ and return the directory.  Return nil if not found."
 \f
 ;;; Backward compatibility to yasnippet <= 0.7
 
+(defun yas-initialize ()
+  "For backward compatibility, enable `yas-minor-mode' globally."
+  (declare (obsolete "Use (yas-global-mode 1) instead." "0.8"))
+  (yas-global-mode 1))
+
 (defvar yas--backported-syms '(;; `defcustom's
                              ;;
                              yas-snippet-dirs
@@ -4523,6 +4517,7 @@ and return the directory.  Return nil if not found."
                              yas-exit-snippet
                              yas-exit-all-snippets
                              yas-skip-and-clear-or-delete-char
+                             yas-initialize
 
                              ;; symbols that I "exported" for use
                              ;; in snippets and hookage