diff --git a/yasnippet.el b/yasnippet.el index c5771d8..24cc3aa 100644 --- a/yasnippet.el +++ b/yasnippet.el @@ -28,9 +28,9 @@ ;;; Commentary: ;; Basic steps to setup: -;; +;; ;; 1. In your .emacs file: -;; (add-to-list 'load-path "/dir/to/yasnippet.el") +;; (add-to-list 'load-path "/dir/to/yasnippet.el") ;; (require 'yasnippet) ;; 2. Place the `snippets' directory somewhere. E.g: ~/.emacs.d/snippets ;; 3. In your .emacs file @@ -48,11 +48,11 @@ ;; ;; `yas/root-directory' ;; -;; The directory where user-created snippets are to be -;; stored. Can also be a list of directories that -;; `yas/reload-all' will use for bulk-reloading snippets. In -;; that case the first directory the default for storing new -;; snippets. +;; The directory where user-created snippets are to be +;; stored. Can also be a list of directories that +;; `yas/reload-all' will use for bulk-reloading snippets. In +;; that case the first directory the default for storing new +;; snippets. ;; ;; `yas/mode-symbol' ;; @@ -75,10 +75,10 @@ ;; ;; M-x yas/insert-snippet ;; -;; Prompts you for possible snippet expansion if that is -;; possible according to buffer-local and snippet-local -;; expansion conditions. With prefix argument, ignore these -;; conditions. +;; Prompts you for possible snippet expansion if that is +;; possible according to buffer-local and snippet-local +;; expansion conditions. With prefix argument, ignore these +;; conditions. ;; ;; M-x yas/find-snippets ;; @@ -108,22 +108,22 @@ ;; ;; M-x yas/tryout-snippet ;; -;; When editing a snippet, this opens a new empty buffer, -;; sets it to the appropriate major mode and inserts the -;; snippet there, so you can see what it looks like. This is -;; bound to "C-c C-t" while in `snippet-mode'. +;; When editing a snippet, this opens a new empty buffer, +;; sets it to the appropriate major mode and inserts the +;; snippet there, so you can see what it looks like. This is +;; bound to "C-c C-t" while in `snippet-mode'. ;; ;; The `dropdown-list.el' extension is bundled with YASnippet, you ;; can optionally use it the preferred "prompting method", puting in ;; your .emacs file, for example: ;; ;; (require 'dropdown-list) -;; (setq 'yas/prompt-functions '(yas/dropdown-prompt -;; yas/ido-prompt -;; yas/completing-prompt)) +;; (setq yas/prompt-functions '(yas/dropdown-prompt +;; yas/ido-prompt +;; yas/completing-prompt)) ;; ;; Also check out the customization group -;; +;; ;; M-x customize-group RET yasnippet RET ;; ;; For more information and detailed usage, refer to the project page: @@ -132,6 +132,7 @@ ;;; Code: (require 'cl) +(require 'assoc) (require 'easymenu) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -154,10 +155,10 @@ bulk reloading of all snippets using `yas/reload-all'" :group 'yasnippet) (defcustom yas/prompt-functions '(yas/x-prompt - yas/dropdown-prompt - yas/completing-prompt - yas/ido-prompt - yas/no-prompt) + yas/dropdown-prompt + yas/completing-prompt + yas/ido-prompt + yas/no-prompt) "Functions to prompt for keys, templates, etc interactively." :type 'list :group 'yasnippet) @@ -252,9 +253,9 @@ arguments." :group 'yasnippet) (defcustom yas/choose-keys-first t - "If non-nil, prompts for key first, then for template if more than one. + "If non-nil, prompt for snippet key first, then for template. -Otherwise prompts for all possible templates +Otherwise prompts for all possible snippet names. This affects `yas/insert-snippet' and `yas/visit-snippet-file'." :type 'boolean @@ -270,13 +271,21 @@ This affects `yas/insert-snippet', `yas/visit-snippet-file'" :type 'boolean :group 'yasnippet) -(defcustom yas/use-menu t +(defcustom yas/use-menu 'real-modes "Display a YASnippet menu in the menu bar. -When non-nil, snippet templates will be listed under the menu -\"Yasnippet\". If set to `abbreviate', only the current major-mode -menu and the modes set in `yas/mode-symbol' are listed." +When non-nil, submenus for each snippet table will be listed +under the menu \"Yasnippet\". + +If set to `real-modes' only submenus whose name more or less +corresponds to a major mode are listed. + +If set to `abbreviate', only the current major-mode +menu and the modes set in `yas/mode-symbol' are listed. + +Any other non-nil value, every submenu is listed." :type '(choice (const :tag "Full" t) + (const :tag "Real modes only" real-modes) (const :tag "Abbreviate" abbreviate)) :group 'yasnippet) @@ -321,7 +330,7 @@ An error string \"[yas] error\" is returned instead." (defun yas/define-some-keys (keys keymap definition) "Bind KEYS to DEFINITION in KEYMAP, read with `read-kbd-macro'." (let ((keys (or (and (listp keys) keys) - (list keys)))) + (list keys)))) (dolist (key keys) (define-key keymap (read-kbd-macro key) definition)))) @@ -410,15 +419,17 @@ Here's an example: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal variables -;; - -(defvar yas/version "0.6.0b") +;; +(defvar yas/version "0.6.1b") (defvar yas/snippet-tables (make-hash-table) - "A hash table of snippet tables corresponding to each major mode.") + "A hash table of MAJOR-MODE symbols to `yas/snippet-table' objects.") (defvar yas/menu-table (make-hash-table) - "A hash table of menus of corresponding major mode.") + "A hash table of MAJOR-MODE symbols to menu keymaps.") + +(defvar yas/active-keybindings nil + "A list of cons (KEYMAP . KEY) setup from defining snippets.") (defvar yas/known-modes '(ruby-mode rst-mode markdown-mode) @@ -459,32 +470,38 @@ Here's an example: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Minor mode stuff ;; -;; TODO: XXX: This is somehow needed in Carbon Emacs for MacOSX +;; TODO: XXX: This is somehow needed in Carbon Emacs for MacOSX (defvar last-buffer-undo-list nil) (defvar yas/minor-mode-map (make-sparse-keymap) - "The keymap used when function `yas/minor-mode' is active.") + "The keymap used when `yas/minor-mode' is active.") (defvar yas/minor-mode-menu (make-sparse-keymap) "Holds the YASnippet menu. For use with `easy-menu-define'.") -(defun yas/init-keymap-and-menu () +(defun yas/init-minor-keymap () (easy-menu-define yas/minor-mode-menu yas/minor-mode-map "Menu used when YAS/minor-mode is active." (cons "YASnippet" - (mapcar #'(lambda (ent) - (when (third ent) - (define-key yas/minor-mode-map (third ent) (second ent))) - (vector (first ent) (second ent) t)) - (list (list "--") - (list "Expand trigger" 'yas/expand (when yas/trigger-key (read-kbd-macro yas/trigger-key))) - (list "Insert at point..." 'yas/insert-snippet "\C-c&\C-s") - (list "Visit snippet file..." 'yas/visit-snippet-file "\C-c&\C-v") - (list "Find snippets..." 'yas/find-snippets "\C-c&\C-f") - (list "About" 'yas/about) - (list "Reload-all-snippets" 'yas/reload-all) - (list "Load snippets..." 'yas/load-directory)))))) + (mapcar #'(lambda (ent) + (when (third ent) + (define-key yas/minor-mode-map (third ent) (second ent))) + (vector (first ent) (second ent) t)) + (list (list "--") + (list "Expand trigger" 'yas/expand (when yas/trigger-key + (read-kbd-macro yas/trigger-key))) + (list "Insert at point..." 'yas/insert-snippet "\C-c&\C-s") + (list "New snippet..." 'yas/new-snippet "\C-c&\C-n") + (list "Visit snippet file..." 'yas/visit-snippet-file "\C-c&\C-v") + (list "Find snippets..." 'yas/find-snippets "\C-c&\C-f") + (list "--") + (list "Load snippets..." 'yas/load-directory) + (list "Reload everything" 'yas/reload-all) + (list "About" 'yas/about)))))) + +(progn + (yas/init-minor-keymap)) (define-minor-mode yas/minor-mode "Toggle YASnippet mode. @@ -507,11 +524,11 @@ Key bindings: (when yas/minor-mode ;; when turning on theminor mode, re-read the `yas/trigger-key' ;; if a `yas/minor-mode-map' is already built. Else, call - ;; `yas/init-keymap-and-menu' to build it + ;; `yas/init-minor-keymap' to build it (if (and (cdr yas/minor-mode-map) - yas/trigger-key) - (define-key yas/minor-mode-map (read-kbd-macro yas/trigger-key) 'yas/expand) - (yas/init-keymap-and-menu)))) + yas/trigger-key) + (define-key yas/minor-mode-map (read-kbd-macro yas/trigger-key) 'yas/expand) + (yas/init-minor-keymap)))) (defun yas/minor-mode-on () "Turn on YASnippet minor mode." @@ -531,51 +548,71 @@ Key bindings: ;; (defvar yas/font-lock-keywords (append '(("^#.*$" . font-lock-comment-face)) - lisp-font-lock-keywords - lisp-font-lock-keywords-1 - lisp-font-lock-keywords-2 - '(("$\\([0-9]+\\)" - (0 font-lock-keyword-face) - (1 font-lock-string-face t)) - ("${\\([0-9]+\\):?" - (0 font-lock-keyword-face) - (1 font-lock-warning-face t)) - ("${" font-lock-keyword-face) - ("$[0-9]+?" font-lock-preprocessor-face) - ("\\(\\$(\\)" 1 font-lock-preprocessor-face) - ("}" - (0 font-lock-keyword-face))))) + lisp-font-lock-keywords + lisp-font-lock-keywords-1 + lisp-font-lock-keywords-2 + '(("$\\([0-9]+\\)" + (0 font-lock-keyword-face) + (1 font-lock-string-face t)) + ("${\\([0-9]+\\):?" + (0 font-lock-keyword-face) + (1 font-lock-warning-face t)) + ("${" font-lock-keyword-face) + ("$[0-9]+?" font-lock-preprocessor-face) + ("\\(\\$(\\)" 1 font-lock-preprocessor-face) + ("}" + (0 font-lock-keyword-face))))) -(defvar snippet-mode-map (make-sparse-keymap)) -(define-key snippet-mode-map "\C-c\C-c" 'yas/load-snippet-buffer) -(define-key snippet-mode-map "\C-c\C-t" 'yas/tryout-snippet) +(defvar snippet-mode-map (make-sparse-keymap) + "The keymap used when `snippet-mode' is active") +(defvar yas/major-mode-menu (make-sparse-keymap) + "Holds the snippet-mode menu. For use with `easy-menu-define'.") -(define-derived-mode snippet-mode text-mode "YASnippet" +(defun yas/init-major-keymap () + (easy-menu-define yas/major-mode-menu + snippet-mode-map + "Menu used when snippet-mode is active." + (cons "Snippet" + (mapcar #'(lambda (ent) + (when (third ent) + (define-key snippet-mode-map (third ent) (second ent))) + (vector (first ent) (second ent) t)) + (list + (list "Load this snippet" 'yas/load-snippet-buffer "\C-c\C-c") + (list "Try out this snippet" 'yas/tryout-snippet "\C-c\C-t")))))) + +(progn + (yas/init-major-keymap)) + +(define-derived-mode snippet-mode text-mode "Snippet" "A mode for editing yasnippets" (set-syntax-table (standard-syntax-table)) (setq font-lock-defaults '(yas/font-lock-keywords)) (set (make-local-variable 'require-final-newline) nil) - (use-local-map snippet-mode-map)) + (use-local-map snippet-mode-map) + (unless (cdr snippet-mode-map) + (yas/init-major-keymap))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal structs for template management -;; +;; (defstruct (yas/template (:constructor yas/make-template - (content name condition env file))) + (content name condition env file keybinding))) "A template for a snippet." content name condition env - file) + file + keybinding) (defstruct (yas/snippet-table (:constructor yas/make-snippet-table (name))) - "A table to store snippets for a perticular mode." - name + "A table to store snippets for a particular mode." + name (hash (make-hash-table :test 'equal)) (parents nil)) @@ -601,16 +638,16 @@ This function implements the rules described in `yas/buffer-local-condition'. See that variables documentation." (let ((requirement (yas/require-template-specific-condition-p))) (if (eq requirement 'always) - templates + templates (remove-if-not #'(lambda (pair) - (let* ((condition (yas/template-condition (cdr pair))) - (result (or (null condition) - (yas/template-condition-predicate condition)))) - (cond ((eq requirement t) - result) - (t - (eq requirement result))))) - templates)))) + (let* ((condition (yas/template-condition (cdr pair))) + (result (or (null condition) + (yas/template-condition-predicate condition)))) + (cond ((eq requirement t) + result) + (t + (eq requirement result))))) + templates)))) (defun yas/snippet-table-fetch (table key) "Fetch a snippet binding to KEY from TABLE." @@ -618,30 +655,43 @@ This function implements the rules described in (yas/filter-templates-by-condition (gethash key (yas/snippet-table-hash table))))) (defun yas/snippet-table-get-all-parents (table) - (let ((parents (yas/snippet-table-parents table))) + (let ((parents (yas/snippet-table-parents table))) (when parents (append parents - (mapcan #'yas/snippet-table-get-all-parents parents))))) + (mapcan #'yas/snippet-table-get-all-parents parents))))) (defun yas/snippet-table-templates (table) (when table (let ((acc)) (maphash #'(lambda (key templates) - (setq acc (append acc templates))) - (yas/snippet-table-hash table)) + (setq acc (append acc templates))) + (yas/snippet-table-hash table)) (yas/filter-templates-by-condition acc)))) (defun yas/snippet-table-all-keys (table) (when table (let ((acc)) (maphash #'(lambda (key templates) - (when (yas/filter-templates-by-condition templates) - (push key acc))) - (yas/snippet-table-hash table)) + (when (yas/filter-templates-by-condition templates) + (push key acc))) + (yas/snippet-table-hash table)) acc))) (defun yas/snippet-table-store (table full-key key template) "Store a snippet template in the TABLE." + ;; If replacing a snippet template, remember to remove its + ;; keybinding first. + ;; + (let ((existing (aget (gethash key (yas/snippet-table-hash table)) + full-key))) + (when (and existing + (yas/template-keybinding existing)) + (define-key + (car (yas/template-keybinding existing)) + (cdr (yas/template-keybinding existing)) + nil))) + ;; Now store the new template + ;; (puthash key (yas/modify-alist (gethash key (yas/snippet-table-hash table)) @@ -667,20 +717,20 @@ a list of modes like this to help the judgement." ;; be stored in cons format instead of string, "Evaluate STRING and convert the result to string." (let ((retval (catch 'yas/exception - (condition-case err - (save-excursion - (save-restriction - (save-match-data - (widen) - (let ((result (eval (read string)))) - (when result - (format "%s" result)))))) - (error (if yas/good-grace - "[yas] elisp error!" - (error (format "[yas] elisp error: %s" - (error-message-string err))))))))) + (condition-case err + (save-excursion + (save-restriction + (save-match-data + (widen) + (let ((result (eval (read string)))) + (when result + (format "%s" result)))))) + (error (if yas/good-grace + "[yas] elisp error!" + (error (format "[yas] elisp error: %s" + (error-message-string err))))))))) (when (and (consp retval) - (eq 'yas/exception (car retval))) + (eq 'yas/exception (car retval))) (error (cdr retval))) retval)) @@ -695,7 +745,7 @@ Optional DIRECTORY gets recorded as the default directory to search for snippet files if the retrieved/created table didn't already have such a property." (let ((table (gethash mode - yas/snippet-tables))) + yas/snippet-tables))) (unless table (setq table (yas/make-snippet-table (symbol-name mode))) (puthash mode table yas/snippet-tables)) @@ -709,22 +759,22 @@ Return tables in this order: optional MODE-SYMBOL, then DONT-SEARCH-PARENTS is non-nil, the guessed parent mode of either MODE-SYMBOL or `major-mode'." (let ((mode-tables - (mapcar #'(lambda (mode) - (gethash mode yas/snippet-tables)) - (append (list mode-symbol) - (if (listp yas/mode-symbol) - yas/mode-symbol - (list yas/mode-symbol)) - (list major-mode - (and (not dont-search-parents) - (get (or mode-symbol major-mode) - 'derived-mode-parent)))))) - (all-tables)) + (mapcar #'(lambda (mode) + (gethash mode yas/snippet-tables)) + (append (list mode-symbol) + (if (listp yas/mode-symbol) + yas/mode-symbol + (list yas/mode-symbol)) + (list major-mode + (and (not dont-search-parents) + (get (or mode-symbol major-mode) + 'derived-mode-parent)))))) + (all-tables)) (dolist (table (remove nil mode-tables)) (push table all-tables) (nconc all-tables (yas/snippet-table-get-all-parents table))) (remove-duplicates all-tables))) - + (defun yas/menu-keymap-get-create (mode) "Get the menu keymap correspondong to MODE." (or (gethash mode yas/menu-table) @@ -744,9 +794,9 @@ the template of a snippet in the current snippet-table." (skip-syntax-backward syntax) (setq start (point))) (setq templates - (mapcan #'(lambda (table) - (yas/snippet-table-fetch table (buffer-substring-no-properties start end))) - (yas/get-snippet-tables))) + (mapcan #'(lambda (table) + (yas/snippet-table-fetch table (buffer-substring-no-properties start end))) + (yas/get-snippet-tables))) (if templates (setq done t) (setq start end))) @@ -787,39 +837,42 @@ Here's a list of currently recognized variables: #include \"$1\"" (goto-char (point-min)) (let* ((name (and file (file-name-nondirectory file))) - (key name) - template - bound - condition - group - env) + (key name) + template + bound + condition + group + env + binding) (if (re-search-forward "^# --\n" nil t) - (progn (setq template - (buffer-substring-no-properties (point) - (point-max))) - (setq bound (point)) - (goto-char (point-min)) - (while (re-search-forward "^# *\\([^ ]+?\\) *: *\\(.*\\)$" bound t) - (when (string= "name" (match-string-no-properties 1)) - (setq name (match-string-no-properties 2))) - (when (string= "condition" (match-string-no-properties 1)) - (setq condition (read (match-string-no-properties 2)))) - (when (string= "group" (match-string-no-properties 1)) - (setq group (match-string-no-properties 2))) - (when (string= "env" (match-string-no-properties 1)) - (setq env (match-string-no-properties 2))) - (when (string= "key" (match-string-no-properties 1)) - (setq key (match-string-no-properties 2))))) + (progn (setq template + (buffer-substring-no-properties (point) + (point-max))) + (setq bound (point)) + (goto-char (point-min)) + (while (re-search-forward "^# *\\([^ ]+?\\) *: *\\(.*\\)$" bound t) + (when (string= "name" (match-string-no-properties 1)) + (setq name (match-string-no-properties 2))) + (when (string= "condition" (match-string-no-properties 1)) + (setq condition (read (match-string-no-properties 2)))) + (when (string= "group" (match-string-no-properties 1)) + (setq group (match-string-no-properties 2))) + (when (string= "expand-env" (match-string-no-properties 1)) + (setq env (match-string-no-properties 2))) + (when (string= "key" (match-string-no-properties 1)) + (setq key (match-string-no-properties 2))) + (when (string= "binding" (match-string-no-properties 1)) + (setq binding (match-string-no-properties 2))))) (setq template - (buffer-substring-no-properties (point-min) (point-max)))) - (list key template name condition group env file))) + (buffer-substring-no-properties (point-min) (point-max)))) + (list key template name condition group env file binding))) (defun yas/subdirs (directory &optional file?) "Return subdirs or files of DIRECTORY according to FILE?." (remove-if (lambda (file) (or (string-match "^\\." (file-name-nondirectory file)) - (string-match "~$" + (string-match "~$" (file-name-nondirectory file)) (if file? (file-directory-p file) @@ -831,11 +884,11 @@ Here's a list of currently recognized variables: (defun yas/expand-from-menu (template) (let ((where (if mark-active - (cons (region-beginning) (region-end)) - (cons (point) (point))))) - (yas/expand-snippet (car where) - (cdr where) - (yas/template-content template)))) + (cons (region-beginning) (region-end)) + (cons (point) (point))))) + (yas/expand-snippet (yas/template-content template) + (car where) + (cdr where)))) (defun yas/modify-alist (alist key value) "Modify ALIST to map KEY to VALUE. return the new alist." @@ -848,93 +901,93 @@ Here's a list of currently recognized variables: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Popping up for keys and templates -;; +;; (defun yas/prompt-for-template (templates &optional prompt) "Interactively choose a template from the list TEMPLATES. TEMPLATES is a list of `yas/template'." (when templates (some #'(lambda (fn) - (funcall fn (or prompt "Choose a snippet: ") - templates - #'yas/template-name)) - yas/prompt-functions))) + (funcall fn (or prompt "Choose a snippet: ") + templates + #'yas/template-name)) + yas/prompt-functions))) (defun yas/prompt-for-keys (keys &optional prompt) "Interactively choose a template key from the list KEYS." (when keys (some #'(lambda (fn) - (funcall fn (or prompt "Choose a snippet key: ") keys)) - yas/prompt-functions))) + (funcall fn (or prompt "Choose a snippet key: ") keys)) + yas/prompt-functions))) (defun yas/prompt-for-table (tables &optional prompt) (when tables (some #'(lambda (fn) - (funcall fn (or prompt "Choose a snippet table: ") - tables - #'yas/snippet-table-name)) - yas/prompt-functions))) + (funcall fn (or prompt "Choose a snippet table: ") + tables + #'yas/snippet-table-name)) + yas/prompt-functions))) (defun yas/x-prompt (prompt choices &optional display-fn) (when (and window-system choices) (let ((keymap (cons 'keymap - (cons - prompt - (mapcar (lambda (choice) - (list choice - 'menu-item - (if display-fn - (funcall display-fn choice) - choice) - t)) - choices))))) + (cons + prompt + (mapcar (lambda (choice) + (list choice + 'menu-item + (if display-fn + (funcall display-fn choice) + choice) + t)) + choices))))) (when (cdr keymap) - (car (x-popup-menu (if (fboundp 'posn-at-point) - (let ((x-y (posn-x-y (posn-at-point (point))))) - (list (list (+ (car x-y) 10) - (+ (cdr x-y) 20)) - (selected-window))) - t) - keymap)))))) + (car (x-popup-menu (if (fboundp 'posn-at-point) + (let ((x-y (posn-x-y (posn-at-point (point))))) + (list (list (+ (car x-y) 10) + (+ (cdr x-y) 20)) + (selected-window))) + t) + keymap)))))) (defun yas/ido-prompt (prompt choices &optional display-fn) (when (and (featurep 'ido) - ido-mode) + ido-mode) (let* ((formatted-choices (or (and display-fn - (mapcar display-fn choices)) - choices)) - (chosen (and formatted-choices - (ido-completing-read prompt - formatted-choices - nil - 'require-match - nil - nil)))) + (mapcar display-fn choices)) + choices)) + (chosen (and formatted-choices + (ido-completing-read prompt + formatted-choices + nil + 'require-match + nil + nil)))) (when chosen - (nth (position chosen formatted-choices :test #'string=) choices))))) + (nth (position chosen formatted-choices :test #'string=) choices))))) (eval-when-compile (require 'dropdown-list nil t)) (defun yas/dropdown-prompt (prompt choices &optional display-fn) (when (featurep 'dropdown-list) (let* ((formatted-choices (or (and display-fn - (mapcar display-fn choices)) - choices)) - (chosen (and formatted-choices - (nth (dropdown-list formatted-choices) - choices)))) + (mapcar display-fn choices)) + choices)) + (chosen (and formatted-choices + (nth (dropdown-list formatted-choices) + choices)))) chosen))) (defun yas/completing-prompt (prompt choices &optional display-fn) (let* ((formatted-choices (or (and display-fn - (mapcar display-fn choices)) - choices)) - (chosen (and formatted-choices - (completing-read prompt - formatted-choices - nil - 'require-match - nil - nil)))) + (mapcar display-fn choices)) + choices)) + (chosen (and formatted-choices + (completing-read prompt + formatted-choices + nil + 'require-match + nil + nil)))) (when chosen (nth (position chosen formatted-choices :test #'string=) choices)))) @@ -943,22 +996,22 @@ TEMPLATES is a list of `yas/template'." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Loading snippets from files -;; +;; (defun yas/load-directory-1 (directory &optional parents no-hierarchy-parents) "Recursively load snippet templates from DIRECTORY." (let* ((major-mode-and-parents (yas/compute-major-mode-and-parents (concat directory "/dummy") - nil - no-hierarchy-parents)) - (mode-sym (car major-mode-and-parents)) - (parents (rest major-mode-and-parents)) - (snippet-defs nil)) + nil + no-hierarchy-parents)) + (mode-sym (car major-mode-and-parents)) + (parents (rest major-mode-and-parents)) + (snippet-defs nil)) (with-temp-buffer (dolist (file (yas/subdirs directory 'no-subdirs-just-files)) (when (file-readable-p file) (insert-file-contents file nil nil nil t) (push (yas/parse-template file) - snippet-defs)))) + snippet-defs)))) (yas/define-snippets mode-sym snippet-defs parents) @@ -975,43 +1028,63 @@ content of the file is the template." (interactive "DSelect the root directory: ") (unless (file-directory-p directory) (error "Error %s not a directory" directory)) - (add-to-list 'yas/root-directory directory) + (unless yas/root-directory + (setq yas/root-directory directory)) (dolist (dir (yas/subdirs directory)) (yas/load-directory-1 dir nil 'no-hierarchy-parents)) (when (interactive-p) (message "done."))) +(defun yas/kill-snippet-keybindings () + "Remove the all active snippet keybindings." + (interactive) + (dolist (keybinding yas/active-keybindings) + (define-key (car keybinding) (cdr keybinding) nil)) + (setq yas/active-keybindings nil)) + (defun yas/reload-all () "Reload all snippets and rebuild the YASnippet menu. " - (interactive) - (let ((restore-global-mode nil) - (restore-minor-mode nil)) + ;; Turn off global modes and minor modes, save their state though + ;; + (let ((restore-global-mode (prog1 yas/global-mode + (yas/global-mode -1))) + (restore-minor-mode (prog1 yas/minor-mode + (yas/minor-mode -1)))) + ;; Empty all snippet tables and all menu tables + ;; (setq yas/snippet-tables (make-hash-table)) (setq yas/menu-table (make-hash-table)) + + ;; The minor mode and major mode keymap's cdr set to nil (this is + ;; the same as `make-sparse-keymap;) (setf (cdr yas/minor-mode-menu) nil) (setf (cdr yas/minor-mode-map) nil) - (when yas/global-mode - (yas/global-mode -1) - (setq restore-global-mode t)) + (setf (cdr yas/major-mode-menu) nil) + (setf (cdr snippet-mode-map) nil) - (when yas/minor-mode - (yas/minor-mode -1) - (setq restore-minor-mode t)) + ;; Initialize both keymaps + ;; + (yas/init-minor-keymap) + (yas/init-major-keymap) - (yas/init-keymap-and-menu) + ;; Now, clean up the other keymaps we might have cluttered up. + (yas/kill-snippet-keybindings) + ;; Reload the directories listed in `yas/root-directory' or prompt + ;; the user to select one. + ;; (if yas/root-directory - (if (listp yas/root-directory) - (dolist (directory yas/root-directory) - (yas/load-directory directory)) - (yas/load-directory yas/root-directory)) + (if (listp yas/root-directory) + (dolist (directory yas/root-directory) + (yas/load-directory directory)) + (yas/load-directory yas/root-directory)) (call-interactively 'yas/load-directory)) - + ;; Restore the mode configuration + ;; (when restore-minor-mode (yas/minor-mode 1)) - (when restore-global-mode (yas/global-mode 1)) @@ -1063,8 +1136,8 @@ Here's the default value for all the parameters: (setq dropdown "dropdown-list.el")) (when (null code) (setq code (concat "(yas/initialize-bundle)" - "\n;;;###autoload" ; break through so that won't - "(require 'yasnippet-bundle)"))) ; be treated as magic comment + "\n;;;###autoload" ; break through so that won't + "(require 'yasnippet-bundle)"))) ; be treated as magic comment (let ((dirs (or (and (listp snippet-roots) snippet-roots) (list snippet-roots))) @@ -1077,7 +1150,7 @@ Here's the default value for all the parameters: (goto-char (point-max)) (insert "\n") (when dropdown - (insert-file-contents dropdown)) + (insert-file-contents dropdown)) (goto-char (point-max)) (insert ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n") (insert ";;;; Auto-generated code ;;;;\n") @@ -1086,37 +1159,37 @@ Here's the default value for all the parameters: " \"Initialize YASnippet and load snippets in the bundle.\"" " (yas/global-mode 1)\n") (flet ((yas/define-snippets - (mode snippets &optional parent-or-parents) - (with-current-buffer bundle-buffer - (insert ";;; snippets for " (symbol-name mode) "\n") - (insert "(yas/define-snippets '" (symbol-name mode) "\n") - (insert "'(\n") - (dolist (snippet snippets) - (insert " (" - (yas/quote-string (car snippet)) - " " - (yas/quote-string (nth 1 snippet)) - " " - (if (nth 2 snippet) - (yas/quote-string (nth 2 snippet)) - "nil") - " " - (if (nth 3 snippet) - (format "'%s" (nth 3 snippet)) - "nil") - " " - (if (nth 4 snippet) - (yas/quote-string (nth 4 snippet)) - "nil") - ")\n")) - (insert " )\n") - (insert (if parent-or-parents - (format "'%s" parent-or-parents) - "nil") - ;; (if directory - ;; (concat "\"" directory "\"") - ;; "nil") - ")\n\n")))) + (mode snippets &optional parent-or-parents) + (with-current-buffer bundle-buffer + (insert ";;; snippets for " (symbol-name mode) "\n") + (insert "(yas/define-snippets '" (symbol-name mode) "\n") + (insert "'(\n") + (dolist (snippet snippets) + (insert " (" + (yas/quote-string (car snippet)) + " " + (yas/quote-string (nth 1 snippet)) + " " + (if (nth 2 snippet) + (yas/quote-string (nth 2 snippet)) + "nil") + " " + (if (nth 3 snippet) + (format "'%s" (nth 3 snippet)) + "nil") + " " + (if (nth 4 snippet) + (yas/quote-string (nth 4 snippet)) + "nil") + ")\n")) + (insert " )\n") + (insert (if parent-or-parents + (format "'%s" parent-or-parents) + "nil") + ;; (if directory + ;; (concat "\"" directory "\"") + ;; "nil") + ")\n\n")))) (dolist (dir dirs) (dolist (subdir (yas/subdirs dir)) (yas/load-directory-1 subdir nil 'no-hierarchy-parents)))) @@ -1135,7 +1208,7 @@ Here's the default value for all the parameters: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Some user level functions -;;; +;;; (defun yas/about () (interactive) @@ -1144,12 +1217,14 @@ Here's the default value for all the parameters: ") -- pluskid /joaotavora "))) (defun yas/define-snippets (mode snippets &optional parent-mode) - "Define snippets for MODE. SNIPPETS is a list of -snippet definitions, each taking the following form: + "Define SNIPPETS for MODE. - (KEY TEMPLATE NAME CONDITION GROUP) +SNIPPETS is a list of snippet definitions, each taking the +following form: -NAME, CONDITION or GROUP may be omitted. + (KEY TEMPLATE NAME CONDITION GROUP VARS FILE KEYBINDING) + +Within these, only TEMPLATE is actually mandatory. Optional PARENT-MODE can be used to specify the parent modes of MODE. It can be a mode symbol of a list of mode symbols. It does @@ -1159,55 +1234,103 @@ That is, when looking a snippet in MODE failed, it can refer to its parent modes." (let ((snippet-table (yas/snippet-table-get-create mode)) (parent-tables (mapcar #'yas/snippet-table-get-create - (if (listp parent-mode) - parent-mode - (list parent-mode)))) + (if (listp parent-mode) + parent-mode + (list parent-mode)))) (keymap (if yas/use-menu (yas/menu-keymap-get-create mode) nil))) + ;; Setup the menu + ;; (when parent-tables (setf (yas/snippet-table-parents snippet-table) parent-tables) (when yas/use-menu - (let ((parent-menu-syms-and-names - (if (listp parent-mode) - (mapcar #'(lambda (sym) - (cons sym (concat "parent mode - " (symbol-name sym)))) - parent-mode) - '((parent-mode . "parent mode"))))) - (mapc #'(lambda (sym-and-name) - (define-key keymap (vector (intern (replace-regexp-in-string " " "_" (cdr sym-and-name)))) - (list 'menu-item (cdr sym-and-name) - (yas/menu-keymap-get-create (car sym-and-name))))) - (reverse parent-menu-syms-and-names))))) - (when (and yas/use-menu - (yas/real-mode? mode)) + (let ((parent-menu-syms-and-names + (if (listp parent-mode) + (mapcar #'(lambda (sym) + (cons sym (concat "parent mode - " (symbol-name sym)))) + parent-mode) + '((parent-mode . "parent mode"))))) + (mapc #'(lambda (sym-and-name) + (define-key keymap + (vector (intern (replace-regexp-in-string " " "_" (cdr sym-and-name)))) + (list 'menu-item (cdr sym-and-name) + (yas/menu-keymap-get-create (car sym-and-name))))) + (reverse parent-menu-syms-and-names))))) + (when yas/use-menu (define-key yas/minor-mode-menu (vector mode) `(menu-item ,(symbol-name mode) ,keymap - :visible (yas/show-menu-p ',mode)))) + :visible (yas/show-menu-p ',mode)))) + ;; Iterate the recently parsed snippets definition + ;; (dolist (snippet snippets) (let* ((full-key (car snippet)) (key (file-name-sans-extension full-key)) - (name (or (nth 2 snippet) (file-name-extension full-key))) - (condition (nth 3 snippet)) - (group (nth 4 snippet)) - (template (yas/make-template (nth 1 snippet) + (name (or (third snippet) (file-name-extension full-key))) + (condition (fourth snippet)) + (group (fifth snippet)) + (keybinding (eighth snippet)) + (template nil)) + ;; Read the snippet's "binding :" expression + ;; + (condition-case err + (when keybinding + (setq keybinding (read (eighth snippet))) + (let* ((mode-map-symbol (intern (concat (symbol-name mode) "-map"))) + (keys (or (and (consp keybinding) + (read-kbd-macro (cdr keybinding))) + (read-kbd-macro keybinding))) + (keymap (or (and (consp keybinding) + (boundp (car keybinding)) + (symbol-value (car keybinding))) + (and (boundp mode-map-symbol) + (symbol-value mode-map-symbol))))) + (if (keymapp keymap) + (progn + (setq keybinding (cons keymap keys)) + (push keybinding yas/active-keybindings)) + (setq keybinding nil)))) + (error + (message "[yas] warning: could not read keybinding %s for snippet \"%s\"" + keybinding name) + (setf keybinding nil))) + + ;; Create the `yas/template' object and store in the + ;; appropriate snippet table + ;; + (setq template (yas/make-template (second snippet) (or name key) condition - (nth 5 snippet) - (nth 6 snippet)))) + (sixth snippet) + (seventh snippet) + keybinding)) (yas/snippet-table-store snippet-table full-key key template) + + ;; Now register the keybinding if it does not conflict! + ;; + (unless (or (not (consp keybinding)) + (lookup-key (car keybinding) (cdr keybinding))) + (define-key + (car keybinding) + (cdr keybinding) + `(lambda () (interactive) (yas/expand-snippet ,(second snippet))))) + + ;; Setup the menu groups, reorganizing from group to group if + ;; necessary + ;; (when yas/use-menu (let ((group-keymap keymap)) - ;; delete this entry from another group if already exists - ;; in some other group. An entry is considered as existing - ;; in another group if its name string-matches. - (yas/delete-from-keymap group-keymap name) - - ;; ... then add this entry to the correct group + ;; Delete this entry from another group if already exists + ;; in some other group. An entry is considered as existing + ;; in another group if its name string-matches. + ;; + (yas/delete-from-keymap group-keymap name) + + ;; ... then add this entry to the correct group (when (and (not (null group)) (not (string= "" group))) (dolist (subgroup (mapcar #'make-symbol @@ -1227,11 +1350,15 @@ its parent modes." (defun yas/show-menu-p (mode) (message "what") - (or (not (eq yas/use-menu 'abbreviate)) - (find mode (cons major-mode - (if (listp yas/mode-symbol) - yas/mode-symbol - (list yas/mode-symbol)))))) + (cond ((eq yas/use-menu 'abbreviate) + (find mode (cons major-mode + (if (listp yas/mode-symbol) + yas/mode-symbol + (list yas/mode-symbol))))) + ((eq yas/use-menu 'real-modes) + (yas/real-mode? mode)) + (t + t))) (defun yas/delete-from-keymap (keymap name) "Recursively delete items name NAME from KEYMAP and its submenus. @@ -1240,31 +1367,33 @@ Skip any submenus named \"parent mode\"" ;; First of all, recursively enter submenus, i.e. the tree is ;; searched depth first so that stale submenus can be found in the ;; higher passes. - ;; + ;; (mapc #'(lambda (item) - (when (and (keymapp (fourth item)) - (stringp (third item)) - (not (string-match "parent mode" (third item)))) - (yas/delete-from-keymap (fourth item) name))) - (rest keymap)) + (when (and (keymapp (fourth item)) + (stringp (third item)) + (not (string-match "parent mode" (third item)))) + (yas/delete-from-keymap (fourth item) name))) + (rest keymap)) ;; (when (keymapp keymap) (let ((pos-in-keymap)) - (while (setq pos-in-keymap (position-if #'(lambda (item) - (and (listp item) - (or - ;; the menu item we want to delete - (and (eq 'menu-item (second item)) - (third item) - (and (string= (third item) name))) - ;; a stale subgroup - (and (keymapp (fourth item)) - (not (and (stringp (third item)) - (string-match "parent mode" (third item)))) - (null (rest (fourth item))))))) - keymap)) - (setf (nthcdr pos-in-keymap keymap) - (nthcdr (+ 1 pos-in-keymap) keymap)))))) + (while (setq pos-in-keymap + (position-if #'(lambda (item) + (and (listp item) + (or + ;; the menu item we want to delete + (and (eq 'menu-item (second item)) + (third item) + (and (string= (third item) name))) + ;; a stale subgroup + (and (keymapp (fourth item)) + (not (and (stringp (third item)) + (string-match "parent mode" + (third item)))) + (null (rest (fourth item))))))) + keymap)) + (setf (nthcdr pos-in-keymap keymap) + (nthcdr (+ 1 pos-in-keymap) keymap)))))) (defun yas/define (mode key template &optional name condition group) "Define a snippet. Expanding KEY into TEMPLATE. @@ -1291,14 +1420,14 @@ conditions to filter out potential expansions." (if (eq 'always yas/buffer-local-condition) 'always (let ((local-condition (yas/template-condition-predicate - yas/buffer-local-condition))) + yas/buffer-local-condition))) (when local-condition - (if (eq local-condition t) - t - (and (consp local-condition) - (eq 'require-snippet-condition (car local-condition)) - (symbolp (cdr local-condition)) - (cdr local-condition))))))) + (if (eq local-condition t) + t + (and (consp local-condition) + (eq 'require-snippet-condition (car local-condition)) + (symbolp (cdr local-condition)) + (cdr local-condition))))))) (defun yas/expand () "Expand a snippet before point. @@ -1311,40 +1440,40 @@ defined in `yas/fallback-behavior'" (defun yas/expand-1 (&optional field) "Actually fo the work for `yas/expand'" (multiple-value-bind (templates start end) (if field - (save-restriction - (narrow-to-region (yas/field-start field) (yas/field-end field)) - (yas/current-key)) - (yas/current-key)) + (save-restriction + (narrow-to-region (yas/field-start field) (yas/field-end field)) + (yas/current-key)) + (yas/current-key)) (if templates - (let ((template (or (and (rest templates) ;; more than one - (yas/prompt-for-template (mapcar #'cdr templates))) - (cdar templates)))) - (when template - (yas/expand-snippet start - end - (yas/template-content template) - (yas/template-env template)))) + (let ((template (or (and (rest templates) ;; more than one + (yas/prompt-for-template (mapcar #'cdr templates))) + (cdar templates)))) + (when template + (yas/expand-snippet (yas/template-content template) + start + end + (yas/template-env template)))) (cond ((eq yas/fallback-behavior 'return-nil) - ;; return nil - nil) - ((eq yas/fallback-behavior 'call-other-command) - (let* ((yas/minor-mode nil) - (command (key-binding (read-kbd-macro yas/trigger-key)))) - (when (commandp command) - (setq this-command command) - (call-interactively command)))) - ((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))))) - (t - ;; also return nil if all the other fallbacks have failed - nil))))) + ;; return nil + nil) + ((eq yas/fallback-behavior 'call-other-command) + (let* ((yas/minor-mode nil) + (command (key-binding (read-kbd-macro yas/trigger-key)))) + (when (commandp command) + (setq this-command command) + (call-interactively command)))) + ((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))))) + (t + ;; also return nil if all the other fallbacks have failed + nil))))) (defun yas/all-templates (tables) "Return all snippet tables applicable for the current buffer. @@ -1354,14 +1483,14 @@ Honours `yas/choose-tables-first', `yas/choose-keys-first' and (when yas/choose-tables-first (setq tables (list (yas/prompt-for-table tables)))) (mapcar #'cdr - (if yas/choose-keys-first - (let ((key (yas/prompt-for-keys - (mapcan #'yas/snippet-table-all-keys tables)))) - (when key - (mapcan #'(lambda (table) - (yas/snippet-table-fetch table key)) - tables))) - (mapcan #'yas/snippet-table-templates tables)))) + (if yas/choose-keys-first + (let ((key (yas/prompt-for-keys + (mapcan #'yas/snippet-table-all-keys tables)))) + (when key + (mapcan #'(lambda (table) + (yas/snippet-table-fetch table key)) + tables))) + (mapcan #'yas/snippet-table-templates tables)))) (defun yas/insert-snippet (&optional no-condition) "Choose a snippet to expand, pop-up a list of choices according @@ -1371,21 +1500,21 @@ With prefix argument NO-CONDITION, bypass filtering of snippets by condition." (interactive "P") (let* ((yas/buffer-local-condition (or (and no-condition - 'always) - yas/buffer-local-condition)) - (templates (yas/all-templates (yas/get-snippet-tables))) - (template (and templates - (or (and (rest templates) ;; more than one template for same key - (yas/prompt-for-template templates)) - (car templates)))) - (where (if mark-active - (cons (region-beginning) (region-end)) - (cons (point) (point))))) + 'always) + yas/buffer-local-condition)) + (templates (yas/all-templates (yas/get-snippet-tables))) + (template (and templates + (or (and (rest templates) ;; more than one template for same key + (yas/prompt-for-template templates)) + (car templates)))) + (where (if mark-active + (cons (region-beginning) (region-end)) + (cons (point) (point))))) (if template - (yas/expand-snippet (car where) - (cdr where) - (yas/template-content template) - (yas/template-env template)) + (yas/expand-snippet (yas/template-content template) + (car where) + (cdr where) + (yas/template-env template)) (message "[yas] No snippets can be inserted here!")))) (defun yas/visit-snippet-file () @@ -1395,46 +1524,47 @@ Only success if selected snippet was loaded from a file. Put the visited file in `snippet-mode'." (interactive) (let* ((yas/buffer-local-condition 'always) - (templates (yas/all-templates (yas/get-snippet-tables))) - (template (and templates - (or (and (rest templates) ;; more than one template for same key - (yas/prompt-for-template templates - "Choose a snippet template to edit: ")) - (car templates))))) + (templates (yas/all-templates (yas/get-snippet-tables))) + (template (and templates + (or (and (rest templates) ;; more than one template for same key + (yas/prompt-for-template templates + "Choose a snippet template to edit: ")) + (car templates))))) (when template (let ((file (yas/template-file template))) - (cond ((and file (file-exists-p file)) - (find-file-other-window file) - (snippet-mode)) - (file - (message "Original file %s no longer exists!" file)) - (t - (message "This snippet was not loaded from a file!"))))))) + (cond ((and file (file-exists-p file)) + (find-file-other-window file) + (snippet-mode)) + (file + (message "Original file %s no longer exists!" file)) + (t + (message "This snippet was not loaded from a file!"))))))) (defun yas/guess-snippet-directory () "Try to guess suitable directories based on `major-mode' and also the current active tables." (let ((main-dir (or (and (listp yas/root-directory) - (first yas/root-directory)) - yas/root-directory - "~/.emacs.d/snippets")) - (mode major-mode) - (options)) + (first yas/root-directory)) + yas/root-directory + "~/.emacs.d/snippets")) + (mode major-mode) + (options)) ;; Lookup main mode and add that to the options - ;; + ;; (push (format "%s/%s" main-dir mode) options) ;; Next lookup the main active table - ;; + ;; (let ((active-tables (first (yas/get-snippet-tables))) - (other-path-alternative main-dir)) + other-path-alternative) (when active-tables - (setq active-tables (cons active-tables - (yas/snippet-table-get-all-parents active-tables)))) + (setq active-tables (cons active-tables + (yas/snippet-table-get-all-parents active-tables)))) (dolist (table (reverse active-tables)) - (setq other-path-alternative - (concat other-path-alternative "/" (yas/snippet-table-name table)))) - (push other-path-alternative options)) + (setq other-path-alternative + (concat main-dir "/" (yas/snippet-table-name table)))) + (when other-path-alternative + (push other-path-alternative options))) ;; Finally add to the options the guessed parent of major-mode ;; (this is almost never works out) (when (get mode 'derived-mode-parent) @@ -1445,8 +1575,8 @@ also the current active tables." "Create a new snippet in guessed current mode's directory." (interactive) (yas/find-snippets same-window - (read-from-minibuffer "Enter snippet name: "))) - + (read-from-minibuffer "Enter snippet name: "))) + (defun yas/find-snippets (&optional same-window file-name) "Look for user snippets in guessed current mode's directory. @@ -1465,57 +1595,67 @@ one of these exists, it is taken and `find-file' is called there, otherwise, proposes to create the first option returned by `yas/guess-directory'." (interactive "P") - (let* ((guessed-directories (yas/guess-snippet-directory)) - (target-directory (first (remove-if-not #'file-exists-p guessed-directories))) - (buffer)) - - (unless target-directory - (when (y-or-n-p (format "Guessed directory (%s) does not exist! Create? " (first guessed-directories))) - (setq target-directory (first guessed-directories)) - (make-directory target-directory 'also-make-parents))) + (let* ((guessed-directories (append (yas/guess-snippet-directory) + (if (listp yas/root-directory) + yas/root-directory + (list yas/root-directory)))) + (target-directory (first guessed-directories)) + (buffer)) + + (while (and guessed-directories + (or (not target-directory) + (not (file-exists-p target-directory)))) + (if (y-or-n-p (format "Guessed directory (%s) does not exist! Create? " + (first guessed-directories))) + (progn + (setq target-directory (first guessed-directories)) + (make-directory target-directory 'also-make-parents)) + (setq guessed-directories (cdr guessed-directories)) + (setq target-directory (first guessed-directories)))) (when target-directory (let ((default-directory target-directory)) - (setq buffer (if file-name - (if same-window - (find-file file-name) - (find-file-other-window file-name)) - (call-interactively (if same-window - 'find-file - 'find-file-other-window)))) - (when buffer - (save-excursion - (set-buffer buffer) - (when (eq major-mode 'fundamental-mode) - (snippet-mode)))))))) + (setq buffer (if file-name + (if same-window + (find-file file-name) + (find-file-other-window file-name)) + (call-interactively (if same-window + 'find-file + 'find-file-other-window)))) + (when buffer + (save-excursion + (set-buffer buffer) + (when (eq major-mode 'fundamental-mode) + (snippet-mode)))))))) (defun yas/compute-major-mode-and-parents (file &optional prompt-if-failed no-hierarchy-parents) (let* ((file-dir (and file - (directory-file-name (file-name-directory file)))) - (major-mode-name (and file-dir - (file-name-nondirectory file-dir))) - (parent-file-dir (and file-dir - (directory-file-name (file-name-directory file-dir)))) - (parent-mode-name (and parent-file-dir - (not no-hierarchy-parents) - (file-name-nondirectory parent-file-dir))) - (major-mode-sym (or (and major-mode-name - (intern major-mode-name)) - (when prompt-if-failed - (read-from-minibuffer "[yas] Cannot auto-detect major mode! Enter a major mode: ")))) - (parent-mode-sym (and parent-mode-name - (intern parent-mode-name))) - (extra-parents-file-name (concat file-dir "/.yas-parents")) - (more-parents (when (file-readable-p extra-parents-file-name) - (mapcar #'intern - (split-string - (with-temp-buffer - (insert-file extra-parents-file-name) - (buffer-substring-no-properties (point-min) - (point-max)))))))) + (directory-file-name (file-name-directory file)))) + (major-mode-name (and file-dir + (file-name-nondirectory file-dir))) + (parent-file-dir (and file-dir + (directory-file-name (file-name-directory file-dir)))) + (parent-mode-name (and parent-file-dir + (not no-hierarchy-parents) + (file-name-nondirectory parent-file-dir))) + (major-mode-sym (or (and major-mode-name + (intern major-mode-name)) + (when prompt-if-failed + (read-from-minibuffer + "[yas] Cannot auto-detect major mode! Enter a major mode: ")))) + (parent-mode-sym (and parent-mode-name + (intern parent-mode-name))) + (extra-parents-file-name (concat file-dir "/.yas-parents")) + (more-parents (when (file-readable-p extra-parents-file-name) + (mapcar #'intern + (split-string + (with-temp-buffer + (insert-file-contents extra-parents-file-name) + (buffer-substring-no-properties (point-min) + (point-max)))))))) (when major-mode-sym (remove nil (append (list major-mode-sym parent-mode-sym) - more-parents))))) + more-parents))))) (defun yas/load-snippet-buffer (&optional kill) "Parse and load current buffer's snippet definition. @@ -1524,43 +1664,53 @@ With optional prefix argument KILL quit the window and buffer." (interactive "P") (if buffer-file-name (let ((major-mode-and-parent (yas/compute-major-mode-and-parents buffer-file-name))) - (if major-mode-and-parent - (let* ((parsed (yas/parse-template buffer-file-name)) - (name (and parsed - (third parsed)))) - (when name - (yas/define-snippets (car major-mode-and-parent) - (list parsed) - (cdr major-mode-and-parent)) - (when (and (buffer-modified-p) - (y-or-n-p "Save snippet? ")) - (save-buffer)) - (if kill - (quit-window kill) - (message "[yas] Snippet \"%s\" loaded for %s." name (car major-mode-and-parent))))) - (message "[yas] Cannot load snippet for unknown major mode"))) + (if major-mode-and-parent + (let* ((parsed (yas/parse-template buffer-file-name)) + (name (and parsed + (third parsed)))) + (when name + (yas/define-snippets (car major-mode-and-parent) + (list parsed) + (cdr major-mode-and-parent)) + (when (and (buffer-modified-p) + (y-or-n-p "Save snippet? ")) + (save-buffer)) + (if kill + (quit-window kill) + (message "[yas] Snippet \"%s\" loaded for %s." + name + (car major-mode-and-parent))))) + (message "[yas] Cannot load snippet for unknown major mode"))) (message "Save the buffer as a file first!"))) (defun yas/tryout-snippet (&optional debug) "Test current buffers's snippet template in other buffer." (interactive "P") (let* ((major-mode-and-parent (yas/compute-major-mode-and-parents buffer-file-name)) - (parsed (and major-mode-and-parent - (fboundp (car major-mode-and-parent)) - (yas/parse-template (symbol-name (car major-mode-and-parent))))) - (template (and parsed - (yas/make-template (second parsed) (third parsed) nil (sixth parsed) nil)))) + (parsed (and major-mode-and-parent + (fboundp (car major-mode-and-parent)) + (yas/parse-template (symbol-name (car major-mode-and-parent))))) + (template (and parsed + (yas/make-template (second parsed) + (third parsed) + nil + (sixth parsed) + nil + nil)))) (cond (template - (let ((buffer-name (format "*YAS TEST: %s*" (yas/template-name template)))) - (set-buffer (switch-to-buffer buffer-name)) - (erase-buffer) - (setq buffer-undo-list nil) - (funcall (car major-mode-and-parent)) - (yas/expand-snippet (point-min) (point-max) (yas/template-content template) (yas/template-env template)) - (when debug - (add-hook 'post-command-hook 'yas/debug-some-vars 't 'local)))) - (t - (message "[yas] Cannot test snippet for unknown major mode"))))) + (let ((buffer-name (format "*YAS TEST: %s*" (yas/template-name template)))) + (set-buffer (switch-to-buffer buffer-name)) + (erase-buffer) + (setq buffer-undo-list nil) + (funcall (car major-mode-and-parent)) + (yas/expand-snippet (yas/template-content template) + (point-min) + (point-max) + (yas/template-env template)) + (when debug + (add-hook 'post-command-hook 'yas/debug-some-vars 't 'local)))) + (t + (message "[yas] Cannot test snippet for unknown major mode"))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; User convenience functions, for using in snippet definitions @@ -1589,19 +1739,19 @@ If found, the content of subexp group SUBEXP (default 0) is (defun yas/choose-value (possibilities) "Prompt for a string in the list POSSIBILITIES and return it." (unless (or yas/moving-away-p - yas/modified-p) + yas/modified-p) (some #'(lambda (fn) - (funcall fn "Choose: " possibilities)) - yas/prompt-functions))) + (funcall fn "Choose: " possibilities)) + yas/prompt-functions))) (defun yas/key-to-value (alist) "Prompt for a string in the list POSSIBILITIES and return it." (unless (or yas/moving-away-p - yas/modified-p) + yas/modified-p) (let ((key (read-key-sequence ""))) (when (stringp key) - (or (cdr (find key alist :key #'car :test #'string=)) - key))))) + (or (cdr (find key alist :key #'car :test #'string=)) + key))))) (defun yas/throw (text) "Throw a yas/exception with TEXT as the reason." @@ -1616,15 +1766,19 @@ Otherwise throw exception." (defun yas/field-value (number) (let* ((snippet (car (yas/snippets-at-point))) - (field (and snippet - (yas/snippet-find-field snippet number)))) + (field (and snippet + (yas/snippet-find-field snippet number)))) (when field (yas/field-text-for-display field)))) -(defun yas/oni (text oni-regexp) - "Runs ruby to parse TEXT with Oniguruma regexp ONI-REGEXP." - (shell-command-to-string (format "ruby -e 'print \"%s\".gsub(\"a\",\"b\")'" "aha"))) - +;; (defun yas/oni (text regexp format &optional options) +;; "Pipes TEXT thru ruby Oniguruma regexp" +;; (replace-regexp-in-string +;; "\n$" +;; "" +;; (shell-command-to-string (format "ruby -e 'puts \"%s\".gsub(\"a\",\"b\")'" text)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Snippet expansion and field management @@ -1686,19 +1840,19 @@ Otherwise throw exception." "Calculate the value of the field/mirror. If there's a transform for this field, apply it. Otherwise, returned nil." (let* ((yas/text (yas/field-text-for-display field)) - (text yas/text) - (yas/modified-p (yas/field-modified-p field)) - (yas/moving-away-p nil) - (transform (if (yas/mirror-p field-or-mirror) - (yas/mirror-transform field-or-mirror) - (yas/field-transform field-or-mirror))) - (start-point (if (yas/mirror-p field-or-mirror) - (yas/mirror-start field-or-mirror) - (yas/field-start field-or-mirror))) - (transformed (and transform - (save-excursion - (goto-char start-point) - (yas/eval-string transform))))) + (text yas/text) + (yas/modified-p (yas/field-modified-p field)) + (yas/moving-away-p nil) + (transform (if (yas/mirror-p field-or-mirror) + (yas/mirror-transform field-or-mirror) + (yas/field-transform field-or-mirror))) + (start-point (if (yas/mirror-p field-or-mirror) + (yas/mirror-start field-or-mirror) + (yas/field-start field-or-mirror))) + (transformed (and transform + (save-excursion + (goto-char start-point) + (yas/eval-string transform))))) transformed)) (defsubst yas/replace-all (from to &optional text) @@ -1713,15 +1867,15 @@ With optional string TEXT do it in that string." (defun yas/snippet-find-field (snippet number) (find-if #'(lambda (field) - (eq number (yas/field-number field))) - (yas/snippet-fields snippet))) + (eq number (yas/field-number field))) + (yas/snippet-fields snippet))) (defun yas/snippet-sort-fields (snippet) "Sort the fields of SNIPPET in navigation order." (setf (yas/snippet-fields snippet) - (sort (yas/snippet-fields snippet) - '(lambda (field1 field2) - (yas/snippet-field-compare field1 field2))))) + (sort (yas/snippet-fields snippet) + '(lambda (field1 field2) + (yas/snippet-field-compare field1 field2))))) (defun yas/snippet-field-compare (field1 field2) "Compare two fields. The field with a number is sorted first. @@ -1742,18 +1896,18 @@ have, compare through the field's start point" "Guess if SNIPPET's FIELD should be skipped." (and (zerop (- (yas/field-start field) (yas/field-end field))) (or (yas/field-parent-field field) - (and (eq field (car (last (yas/snippet-fields snippet)))) - (= (yas/field-start field) (overlay-end (yas/snippet-control-overlay snippet))))))) + (and (eq field (car (last (yas/snippet-fields snippet)))) + (= (yas/field-start field) (overlay-end (yas/snippet-control-overlay snippet))))))) (defun yas/snippets-at-point (&optional all-snippets) "Return a sorted list of snippets at point, most recently inserted first." (sort (remove nil (remove-duplicates (mapcar #'(lambda (ov) - (overlay-get ov 'yas/snippet)) - (if all-snippets - (overlays-in (point-min) (point-max)) - (overlays-at (point)))))) + (overlay-get ov 'yas/snippet)) + (if all-snippets + (overlays-in (point-min) (point-max)) + (overlays-at (point)))))) #'(lambda (s1 s2) (<= (yas/snippet-id s2) (yas/snippet-id s1))))) @@ -1763,10 +1917,10 @@ delegate to `yas/next-field'." (interactive) (if yas/triggers-in-field (let ((yas/fallback-behavior 'return-nil) - (active-field (overlay-get yas/active-field-overlay 'yas/field))) - (when active-field - (unless (yas/expand-1 active-field) - (yas/next-field)))) + (active-field (overlay-get yas/active-field-overlay 'yas/field))) + (when active-field + (unless (yas/expand-1 active-field) + (yas/next-field)))) (yas/next-field))) (defun yas/next-field (&optional arg) @@ -1775,24 +1929,24 @@ delegate to `yas/next-field'." (let* ((arg (or arg 1)) (snippet (first (yas/snippets-at-point))) - (active-field (overlay-get yas/active-field-overlay 'yas/field)) + (active-field (overlay-get yas/active-field-overlay 'yas/field)) (live-fields (remove-if #'(lambda (field) - (and (not (eq field active-field)) - (yas/field-probably-deleted-p snippet field))) - (yas/snippet-fields snippet))) - (active-field-pos (position active-field live-fields)) - (target-pos (and active-field-pos (+ arg active-field-pos))) - (target-field (nth target-pos live-fields))) + (and (not (eq field active-field)) + (yas/field-probably-deleted-p snippet field))) + (yas/snippet-fields snippet))) + (active-field-pos (position active-field live-fields)) + (target-pos (and active-field-pos (+ arg active-field-pos))) + (target-field (nth target-pos live-fields))) ;; First check if we're moving out of a field with a transform - ;; + ;; (when (and active-field - (yas/field-transform active-field)) + (yas/field-transform active-field)) (let* ((yas/moving-away-p t) - (yas/text (yas/field-text-for-display active-field)) - (text yas/text) - (yas/modified-p (yas/field-modified-p active-field))) - ;;; primary field transform: exit call to field-transform - (yas/eval-string (yas/field-transform active-field)))) + (yas/text (yas/field-text-for-display active-field)) + (text yas/text) + (yas/modified-p (yas/field-modified-p active-field))) + ;;; primary field transform: exit call to field-transform + (yas/eval-string (yas/field-transform active-field)))) ;; Now actually move... (cond ((>= target-pos (length live-fields)) (yas/exit-snippet snippet)) @@ -1817,8 +1971,8 @@ Also create some protection overlays" ;;; primary field transform: first call to snippet transform (unless (yas/field-modified-p field) (if (yas/field-update-display field snippet) - (let ((inhibit-modification-hooks t)) - (yas/update-mirrors snippet)) + (let ((inhibit-modification-hooks t)) + (yas/update-mirrors snippet)) (setf (yas/field-modified-p field) nil)))) (defun yas/prev-field () @@ -1831,8 +1985,17 @@ Also create some protection overlays" (interactive) (setf (yas/snippet-force-exit snippet) t) (goto-char (if (yas/snippet-exit snippet) - (yas/exit-marker (yas/snippet-exit snippet)) - (overlay-end (yas/snippet-control-overlay snippet))))) + (yas/exit-marker (yas/snippet-exit snippet)) + (overlay-end (yas/snippet-control-overlay snippet))))) + +(defun yas/exit-all-snippets () + "Exit all snippets." + (interactive) + (mapc #'(lambda (snippet) + (yas/exit-snippet snippet) + (yas/check-commit-snippet)) + (yas/snippets-at-point))) + ;;; Apropos markers-to-points: ;;; @@ -1853,36 +2016,41 @@ where POINT is the original position of the marker and MARKER is the original marker object with the position set to nil." (dolist (field (yas/snippet-fields snippet)) (let ((start (marker-position (yas/field-start field))) - (end (marker-position (yas/field-end field)))) + (end (marker-position (yas/field-end field)))) (set-marker (yas/field-start field) nil) (set-marker (yas/field-end field) nil) (setf (yas/field-start field) (cons start (yas/field-start field))) (setf (yas/field-end field) (cons end (yas/field-end field)))) (dolist (mirror (yas/field-mirrors field)) (let ((start (marker-position (yas/mirror-start mirror))) - (end (marker-position (yas/mirror-end mirror)))) - (set-marker (yas/mirror-start mirror) nil) - (set-marker (yas/mirror-end mirror) nil) - (setf (yas/mirror-start mirror) (cons start (yas/mirror-start mirror))) - (setf (yas/mirror-end mirror) (cons end (yas/mirror-end mirror)))))) + (end (marker-position (yas/mirror-end mirror)))) + (set-marker (yas/mirror-start mirror) nil) + (set-marker (yas/mirror-end mirror) nil) + (setf (yas/mirror-start mirror) (cons start (yas/mirror-start mirror))) + (setf (yas/mirror-end mirror) (cons end (yas/mirror-end mirror)))))) (let ((snippet-exit (yas/snippet-exit snippet))) - (when snippet-exit + (when snippet-exit (let ((exit (marker-position (yas/exit-marker snippet-exit)))) - (set-marker (yas/exit-marker snippet-exit) nil) - (setf (yas/exit-marker snippet-exit) (cons exit (yas/exit-marker snippet-exit))))))) + (set-marker (yas/exit-marker snippet-exit) nil) + (setf (yas/exit-marker snippet-exit) (cons exit (yas/exit-marker snippet-exit))))))) (defun yas/points-to-markers (snippet) "Convert all cons (POINT . MARKER) in SNIPPET to markers. This is done by setting MARKER to POINT with `set-marker'." (dolist (field (yas/snippet-fields snippet)) - (setf (yas/field-start field) (set-marker (cdr (yas/field-start field)) (car (yas/field-start field)))) - (setf (yas/field-end field) (set-marker (cdr (yas/field-end field)) (car (yas/field-end field)))) + (setf (yas/field-start field) (set-marker (cdr (yas/field-start field)) + (car (yas/field-start field)))) + (setf (yas/field-end field) (set-marker (cdr (yas/field-end field)) + (car (yas/field-end field)))) (dolist (mirror (yas/field-mirrors field)) - (setf (yas/mirror-start mirror) (set-marker (cdr (yas/mirror-start mirror)) (car (yas/mirror-start mirror)))) - (setf (yas/mirror-end mirror) (set-marker (cdr (yas/mirror-end mirror)) (car (yas/mirror-end mirror)))))) + (setf (yas/mirror-start mirror) (set-marker (cdr (yas/mirror-start mirror)) + (car (yas/mirror-start mirror)))) + (setf (yas/mirror-end mirror) (set-marker (cdr (yas/mirror-end mirror)) + (car (yas/mirror-end mirror)))))) (let ((snippet-exit (yas/snippet-exit snippet))) (when snippet-exit - (setf (yas/exit-marker snippet-exit) (set-marker (cdr (yas/exit-marker snippet-exit)) (car (yas/exit-marker snippet-exit))))))) + (setf (yas/exit-marker snippet-exit) (set-marker (cdr (yas/exit-marker snippet-exit)) + (car (yas/exit-marker snippet-exit))))))) (defun yas/commit-snippet (snippet &optional no-hooks) "Commit SNIPPET, but leave point as it is. This renders the @@ -1894,8 +2062,8 @@ exiting the snippet. NO-HOOKS means don't run the `yas/after-exit-snippet-hook' hooks." (let ((control-overlay (yas/snippet-control-overlay snippet)) - yas/snippet-beg - yas/snippet-end) + yas/snippet-beg + yas/snippet-end) ;; ;; Save the end of the moribund snippet in case we need to revive it ;; its original expansion. @@ -1908,9 +2076,9 @@ NO-HOOKS means don't run the `yas/after-exit-snippet-hook' hooks." (let ((inhibit-modification-hooks t)) (when yas/active-field-overlay - (delete-overlay yas/active-field-overlay)) + (delete-overlay yas/active-field-overlay)) (when yas/field-protection-overlays - (mapc #'delete-overlay yas/field-protection-overlays))) + (mapc #'delete-overlay yas/field-protection-overlays))) ;; stacked expansion: if the original expansion took place from a ;; field, make sure we advance it here at least to @@ -1918,7 +2086,7 @@ NO-HOOKS means don't run the `yas/after-exit-snippet-hook' hooks." ;; (let ((previous-field (yas/snippet-previous-active-field snippet))) (when (and yas/snippet-end previous-field) - (yas/advance-end-maybe previous-field yas/snippet-end))) + (yas/advance-end-maybe previous-field yas/snippet-end))) ;; Convert all markers to points, ;; @@ -1927,12 +2095,12 @@ NO-HOOKS means don't run the `yas/after-exit-snippet-hook' hooks." ;; Take care of snippet revival ;; (if yas/snippet-revival - (push `(apply yas/snippet-revive ,yas/snippet-beg ,yas/snippet-end ,snippet) - buffer-undo-list) + (push `(apply yas/snippet-revive ,yas/snippet-beg ,yas/snippet-end ,snippet) + buffer-undo-list) ;; Dismember the snippet... this is useful if we get called ;; again from `yas/take-care-of-redo'.... (setf (yas/snippet-fields snippet) nil)) - + ;; XXX: `yas/after-exit-snippet-hook' should be run with ;; `yas/snippet-beg' and `yas/snippet-end' bound. That might not ;; be the case if the main overlay had somehow already @@ -1940,43 +2108,43 @@ NO-HOOKS means don't run the `yas/after-exit-snippet-hook' hooks." ;; up... ;; (unless no-hooks (run-hooks 'yas/after-exit-snippet-hook))) - + (message "[yas] snippet exited.")) (defun yas/check-commit-snippet () "Checks if point exited the currently active field of the snippet, if so cleans up the whole snippet up." (let* ((snippets (yas/snippets-at-point 'all-snippets)) - (snippets-left snippets)) + (snippets-left snippets)) (dolist (snippet snippets) (let ((active-field (yas/snippet-active-field snippet))) - (cond ((or (prog1 (yas/snippet-force-exit snippet) - (setf (yas/snippet-force-exit snippet) nil)) - (not (and active-field (yas/field-contains-point-p active-field)))) - (setq snippets-left (delete snippet snippets-left)) - (yas/commit-snippet snippet snippets-left)) - ((and active-field - (or (not yas/active-field-overlay) - (not (overlay-buffer yas/active-field-overlay)))) - ;; - ;; stacked expansion: this case is mainly for recent - ;; snippet exits that place us back int the field of - ;; another snippet - ;; - (save-excursion - (yas/move-to-field snippet active-field) - (yas/update-mirrors snippet))) - (t - nil)))) + (cond ((or (prog1 (yas/snippet-force-exit snippet) + (setf (yas/snippet-force-exit snippet) nil)) + (not (and active-field (yas/field-contains-point-p active-field)))) + (setq snippets-left (delete snippet snippets-left)) + (yas/commit-snippet snippet snippets-left)) + ((and active-field + (or (not yas/active-field-overlay) + (not (overlay-buffer yas/active-field-overlay)))) + ;; + ;; stacked expansion: this case is mainly for recent + ;; snippet exits that place us back int the field of + ;; another snippet + ;; + (save-excursion + (yas/move-to-field snippet active-field) + (yas/update-mirrors snippet))) + (t + nil)))) (unless snippets-left (remove-hook 'post-command-hook 'yas/post-command-handler 'local) (remove-hook 'pre-command-hook 'yas/pre-command-handler 'local)))) (defun yas/field-contains-point-p (field &optional point) (let ((point (or point - (point)))) + (point)))) (and (>= point (yas/field-start field)) - (<= point (yas/field-end field))))) + (<= point (yas/field-end field))))) (defun yas/field-text-for-display (field) "Return the propertized display text for field FIELD. " @@ -2006,16 +2174,16 @@ holds the keymap." Otherwise deletes a character normally by calling `delete-char'." (interactive) (let ((field (or field - (and yas/active-field-overlay - (overlay-buffer yas/active-field-overlay) - (overlay-get yas/active-field-overlay 'yas/field))))) + (and yas/active-field-overlay + (overlay-buffer yas/active-field-overlay) + (overlay-get yas/active-field-overlay 'yas/field))))) (cond ((and field - (not (yas/field-modified-p field)) - (eq (point) (marker-position (yas/field-start field)))) - (yas/skip-and-clear field) - (yas/next-field 1)) - (t - (call-interactively 'delete-char))))) + (not (yas/field-modified-p field)) + (eq (point) (marker-position (yas/field-start field)))) + (yas/skip-and-clear field) + (yas/next-field 1)) + (t + (call-interactively 'delete-char))))) (defun yas/skip-and-clear (field) "Deletes the region of FIELD and sets it modified state to t" @@ -2027,19 +2195,21 @@ Otherwise deletes a character normally by calling `delete-char'." Move the overlay, or create it if it does not exit." (if (and yas/active-field-overlay - (overlay-buffer yas/active-field-overlay)) + (overlay-buffer yas/active-field-overlay)) (move-overlay yas/active-field-overlay - (yas/field-start field) - (yas/field-end field)) + (yas/field-start field) + (yas/field-end field)) (setq yas/active-field-overlay - (make-overlay (yas/field-start field) - (yas/field-end field) - nil nil t)) + (make-overlay (yas/field-start field) + (yas/field-end field) + nil nil t)) (overlay-put yas/active-field-overlay 'face 'yas/field-highlight-face) (overlay-put yas/active-field-overlay 'yas/snippet snippet) (overlay-put yas/active-field-overlay 'modification-hooks '(yas/on-field-overlay-modification)) - (overlay-put yas/active-field-overlay 'insert-in-front-hooks '(yas/on-field-overlay-modification)) - (overlay-put yas/active-field-overlay 'insert-behind-hooks '(yas/on-field-overlay-modification)))) + (overlay-put yas/active-field-overlay 'insert-in-front-hooks + '(yas/on-field-overlay-modification)) + (overlay-put yas/active-field-overlay 'insert-behind-hooks + '(yas/on-field-overlay-modification)))) (defun yas/on-field-overlay-modification (overlay after? beg end &optional length) "Clears the field and updates mirrors, conditionally. @@ -2050,20 +2220,20 @@ progress." (unless (yas/undo-in-progress) (let ((field (overlay-get yas/active-field-overlay 'yas/field))) (cond (after? - (yas/advance-end-maybe field (overlay-end overlay)) - ;;; primary field transform: normal calls to expression - (let ((saved-point (point))) - (yas/field-update-display field (car (yas/snippets-at-point))) - (goto-char saved-point)) - (yas/update-mirrors (car (yas/snippets-at-point)))) - (field - (when (and (not after?) - (not (yas/field-modified-p field)) - (eq (point) (if (markerp (yas/field-start field)) - (marker-position (yas/field-start field)) - (yas/field-start field)))) - (yas/skip-and-clear field)) - (setf (yas/field-modified-p field) t)))))) + (yas/advance-end-maybe field (overlay-end overlay)) + ;;; primary field transform: normal calls to expression + (let ((saved-point (point))) + (yas/field-update-display field (car (yas/snippets-at-point))) + (goto-char saved-point)) + (yas/update-mirrors (car (yas/snippets-at-point)))) + (field + (when (and (not after?) + (not (yas/field-modified-p field)) + (eq (point) (if (markerp (yas/field-start field)) + (marker-position (yas/field-start field)) + (yas/field-start field)))) + (yas/skip-and-clear field)) + (setf (yas/field-modified-p field) t)))))) ;;; Apropos protection overlays: ;;; @@ -2088,47 +2258,49 @@ progress." Move the overlays, or create them if they do not exit." (let ((start (yas/field-start field)) - (end (yas/field-end field))) + (end (yas/field-end field))) ;; First check if the (1+ end) is contained in the buffer, ;; otherwise we'll have to do a bit of cheating and silently ;; insert a newline. the `(1+ (buffer-size))' should prevent this ;; when using stacked expansion - ;; + ;; (when (< (buffer-size) end) (save-excursion - (let ((inhibit-modification-hooks t)) - (goto-char (point-max)) - (newline)))) + (let ((inhibit-modification-hooks t)) + (goto-char (point-max)) + (newline)))) ;; go on to normal overlay creation/moving - ;; + ;; (cond ((and yas/field-protection-overlays - (every #'overlay-buffer yas/field-protection-overlays)) - (move-overlay (first yas/field-protection-overlays) (1- start) start) - (move-overlay (second yas/field-protection-overlays) end (1+ end))) - (t - (setq yas/field-protection-overlays - (list (make-overlay (1- start) start nil t nil) - (make-overlay end (1+ end) nil t nil))) - (dolist (ov yas/field-protection-overlays) - (overlay-put ov 'face 'yas/field-debug-face) - (overlay-put ov 'yas/snippet snippet) - ;; (overlay-put ov 'evaporate t) - (overlay-put ov 'modification-hooks '(yas/on-protection-overlay-modification))))))) + (every #'overlay-buffer yas/field-protection-overlays)) + (move-overlay (first yas/field-protection-overlays) (1- start) start) + (move-overlay (second yas/field-protection-overlays) end (1+ end))) + (t + (setq yas/field-protection-overlays + (list (make-overlay (1- start) start nil t nil) + (make-overlay end (1+ end) nil t nil))) + (dolist (ov yas/field-protection-overlays) + (overlay-put ov 'face 'yas/field-debug-face) + (overlay-put ov 'yas/snippet snippet) + ;; (overlay-put ov 'evaporate t) + (overlay-put ov 'modification-hooks '(yas/on-protection-overlay-modification))))))) (defvar yas/protection-violation nil "When non-nil, signals attempts to erronesly exit or modify the snippet. Functions in the `post-command-hook', for example -`yas/post-command-handler' can check it and reset its value to nil. The variables value is the point where the violation originated") +`yas/post-command-handler' can check it and reset its value to +nil. The variables value is the point where the violation +originated") (defun yas/on-protection-overlay-modification (overlay after? beg end &optional length) "Signals a snippet violation, then issues error. The error should be ignored in `debug-ignored-errors'" (cond ((not (or after? - (yas/undo-in-progress))) - (setq yas/protection-violation (point)) - (error "Exit the snippet first!")))) + (yas/undo-in-progress))) + (setq yas/protection-violation (point)) + (error "Exit the snippet first!")))) (add-to-list 'debug-ignored-errors "^Exit the snippet first!$") @@ -2155,23 +2327,40 @@ The error should be ignored in `debug-ignored-errors'" ;;; they should account for all situations... ;;; -(defun yas/expand-snippet (start end template &optional snippet-vars) +(defun yas/expand-snippet (template &optional start end snippet-vars) "Expand snippet at current point. Text between START and END will be deleted before inserting template." (run-hooks 'yas/before-expand-snippet-hook) - (goto-char start) + + ;; If a region is active, set `yas/selected-text' + (setq yas/selected-text + (when mark-active + (prog1 (buffer-substring-no-properties (region-beginning) + (region-end)) + (unless start (setq start (region-beginning)) + (unless end (setq end (region-end))))))) + + (when start + (goto-char start)) ;; stacked expansion: shoosh the overlay modification hooks - ;; - (let ((key (buffer-substring-no-properties start end)) - (inhibit-modification-hooks t) - (column (current-column)) - snippet) + ;; + (let ((to-delete (and start end (buffer-substring-no-properties start end))) + (start (or start (point))) + (end (or end (point))) + (inhibit-modification-hooks t) + (column (current-column)) + snippet) - ;; Delete the trigger key, this *does* get undo-recorded. + + + + ;; Delete the region to delete, this *does* get undo-recorded. ;; - (delete-region start end) - + (when to-delete + (delete-region start end) + (setq yas/deleted-text to-delete)) + ;; Narrow the region down to the template, shoosh the ;; `buffer-undo-list', and create the snippet, the new snippet ;; updates its mirrors once, so we are left with some plain text. @@ -2180,49 +2369,51 @@ will be deleted before inserting template." (save-restriction (narrow-to-region start start) (let ((buffer-undo-list t)) - ;; snippet creation might evaluate users elisp, which - ;; might generate errors, so we have to be ready to catch - ;; them mostly to make the undo information - ;; - (setq yas/start-column (save-restriction (widen) (current-column))) - (insert template) - (setq yas/deleted-text key) - (setq yas/selected-text (when mark-active key)) - (setq snippet - (if snippet-vars - (eval `(let ,(read snippet-vars) - (yas/snippet-create (point-min) (point-max)))) - (yas/snippet-create (point-min) (point-max)))))) + ;; snippet creation might evaluate users elisp, which + ;; might generate errors, so we have to be ready to catch + ;; them mostly to make the undo information + ;; + (setq yas/start-column (save-restriction (widen) (current-column))) + (insert template) + + (setq snippet + (if snippet-vars + (let ((read-vars (condition-case err + (read snippet-vars) + (error nil)))) + (eval `(let ,read-vars + (yas/snippet-create (point-min) (point-max))))) + (yas/snippet-create (point-min) (point-max)))))) ;; stacked-expansion: This checks for stacked expansion, save the ;; `yas/previous-active-field' and advance its boudary. ;; (let ((existing-field (and yas/active-field-overlay - (overlay-buffer yas/active-field-overlay) - (overlay-get yas/active-field-overlay 'yas/field)))) + (overlay-buffer yas/active-field-overlay) + (overlay-get yas/active-field-overlay 'yas/field)))) (when existing-field - (setf (yas/snippet-previous-active-field snippet) existing-field) - (yas/advance-end-maybe existing-field (overlay-end yas/active-field-overlay)))) - + (setf (yas/snippet-previous-active-field snippet) existing-field) + (yas/advance-end-maybe existing-field (overlay-end yas/active-field-overlay)))) + ;; Exit the snippet immediately if no fields ;; (unless (yas/snippet-fields snippet) (yas/exit-snippet snippet)) - + ;; Push two undo actions: the deletion of the inserted contents of - ;; the new snippet (whitout the "key") followed by an apply of + ;; the new snippet (without the "key") followed by an apply of ;; `yas/take-care-of-redo' on the newly inserted snippet boundaries - ;; + ;; (let ((start (overlay-start (yas/snippet-control-overlay snippet))) - (end (overlay-end (yas/snippet-control-overlay snippet)))) + (end (overlay-end (yas/snippet-control-overlay snippet)))) (push (cons start end) buffer-undo-list) (push `(apply yas/take-care-of-redo ,start ,end ,snippet) - buffer-undo-list)) + buffer-undo-list)) ;; Now, move to the first field ;; (let ((first-field (car (yas/snippet-fields snippet)))) (when first-field - (yas/move-to-field snippet first-field)))) + (yas/move-to-field snippet first-field)))) (message "[yas] snippet expanded.")) (defun yas/take-care-of-redo (beg end snippet) @@ -2252,18 +2443,18 @@ After revival, push the `yas/take-care-of-redo' in the ;; try to revive the whole thing... ;; (let ((target-field (or (yas/snippet-active-field snippet) - (car (yas/snippet-fields snippet))))) + (car (yas/snippet-fields snippet))))) (when target-field (setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay snippet beg end)) (overlay-put (yas/snippet-control-overlay snippet) 'yas/snippet snippet) - + (yas/move-to-field snippet target-field) (add-hook 'post-command-hook 'yas/post-command-handler nil t) (add-hook 'pre-command-hook 'yas/pre-command-handler t t) - + (push `(apply yas/take-care-of-redo ,beg ,end ,snippet) - buffer-undo-list)))) + buffer-undo-list)))) (defun yas/snippet-create (begin end) "Creates a snippet from an template inserted between BEGIN and END. @@ -2275,12 +2466,13 @@ Returns the newly created snippet." ;; Sort and link each field (yas/snippet-sort-fields snippet) - + ;; Update the mirrors for the first time (yas/update-mirrors snippet) ;; Create keymap overlay for snippet - (setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay snippet (point-min) (point-max))) + (setf (yas/snippet-control-overlay snippet) + (yas/make-control-overlay snippet (point-min) (point-max))) ;; Move to end (goto-char (point-max)) @@ -2288,7 +2480,7 @@ Returns the newly created snippet." ;; Setup hooks (add-hook 'post-command-hook 'yas/post-command-handler nil t) (add-hook 'pre-command-hook 'yas/pre-command-handler t t) - + snippet)) ;;; apropos adjacencies: Once the $-constructs bits like "$n" and @@ -2310,27 +2502,27 @@ Returns the newly created snippet." (defun yas/fom-start (fom) (cond ((yas/field-p fom) - (yas/field-start fom)) - ((yas/mirror-p fom) - (yas/mirror-start fom)) - (t - (yas/exit-marker fom)))) + (yas/field-start fom)) + ((yas/mirror-p fom) + (yas/mirror-start fom)) + (t + (yas/exit-marker fom)))) (defun yas/fom-end (fom) (cond ((yas/field-p fom) - (yas/field-end fom)) - ((yas/mirror-p fom) - (yas/mirror-end fom)) - (t - (yas/exit-marker fom)))) + (yas/field-end fom)) + ((yas/mirror-p fom) + (yas/mirror-end fom)) + (t + (yas/exit-marker fom)))) (defun yas/fom-next (fom) (cond ((yas/field-p fom) - (yas/field-next fom)) - ((yas/mirror-p fom) - (yas/mirror-next fom)) - (t - (yas/exit-next fom)))) + (yas/field-next fom)) + ((yas/mirror-p fom) + (yas/mirror-next fom)) + (t + (yas/exit-next fom)))) (defun yas/calculate-adjacencies (snippet) "Calculate adjacencies for fields or mirrors of SNIPPET. @@ -2338,29 +2530,29 @@ Returns the newly created snippet." This is according to their relative positions in the buffer, and has to be called before the $-constructs are deleted." (flet ((yas/fom-set-next-fom (fom nextfom) - (cond ((yas/field-p fom) - (setf (yas/field-next fom) nextfom)) - ((yas/mirror-p fom) - (setf (yas/mirror-next fom) nextfom)) - (t - (setf (yas/exit-next fom) nextfom)))) - (yas/compare-fom-begs (fom1 fom2) - (> (yas/fom-start fom2) (yas/fom-start fom1))) - (yas/link-foms (fom1 fom2) - (yas/fom-set-next-fom fom1 fom2))) - ;; make some yas/field, yas/mirror and yas/exit soup + (cond ((yas/field-p fom) + (setf (yas/field-next fom) nextfom)) + ((yas/mirror-p fom) + (setf (yas/mirror-next fom) nextfom)) + (t + (setf (yas/exit-next fom) nextfom)))) + (yas/compare-fom-begs (fom1 fom2) + (> (yas/fom-start fom2) (yas/fom-start fom1))) + (yas/link-foms (fom1 fom2) + (yas/fom-set-next-fom fom1 fom2))) + ;; make some yas/field, yas/mirror and yas/exit soup (let ((soup)) (when (yas/snippet-exit snippet) - (push (yas/snippet-exit snippet) soup)) + (push (yas/snippet-exit snippet) soup)) (dolist (field (yas/snippet-fields snippet)) - (push field soup) - (dolist (mirror (yas/field-mirrors field)) - (push mirror soup))) + (push field soup) + (dolist (mirror (yas/field-mirrors field)) + (push mirror soup))) (setq soup - (sort soup - #'yas/compare-fom-begs)) + (sort soup + #'yas/compare-fom-begs)) (when soup - (reduce #'yas/link-foms soup))))) + (reduce #'yas/link-foms soup))))) (defun yas/advance-end-maybe (fom newend) "Maybe advance FOM's end to NEWEND if it needs it. @@ -2375,8 +2567,8 @@ If it does, also: (set-marker (yas/fom-end fom) newend) (yas/advance-start-maybe (yas/fom-next fom) newend) (if (and (yas/field-p fom) - (yas/field-parent-field fom)) - (yas/advance-end-maybe (yas/field-parent-field fom) newend)))) + (yas/field-parent-field fom)) + (yas/advance-end-maybe (yas/field-parent-field fom) newend)))) (defun yas/advance-start-maybe (fom newstart) "Maybe advance FOM's start to NEWSTART if it needs it. @@ -2392,9 +2584,9 @@ necessary fields, mirrors and exit points. Meant to be called in a narrowed buffer, does various passes" (let ((parse-start (point)) - (dollar-regions (list 'reg))) + (dollar-regions (list 'reg))) ;; protect quote and backquote escapes - ;; + ;; (yas/protect-escapes nil '(?` ?')) ;; replace all backquoted expressions ;; @@ -2406,11 +2598,11 @@ Meant to be called in a narrowed buffer, does various passes" (goto-char parse-start) (yas/protect-escapes) ;; parse fields with {} - ;; + ;; (goto-char parse-start) (yas/field-parse-create snippet dollar-regions) ;; parse simple mirrors and fields - ;; + ;; (goto-char parse-start) (yas/simple-mirror-parse-create snippet dollar-regions) ;; parse mirror transforms @@ -2440,55 +2632,55 @@ Meant to be called in a narrowed buffer, does various passes" (while (re-search-forward "$>" nil t) (delete-region (match-beginning 0) (match-end 0)) (when (not (eq yas/indent-line 'auto)) - (indent-according-to-mode)))) + (indent-according-to-mode)))) (save-excursion (cond ((eq yas/indent-line 'fixed) - (let* ((indent (if indent-tabs-mode - (concat (make-string (/ column tab-width) ?\t) - (make-string (% column tab-width) ?\ )) - (make-string (current-column) ?\ )))) - (goto-char (point-min)) - (while (and (zerop (forward-line)) - (= (current-column) 0)) - (insert indent)))) - ((eq yas/indent-line 'auto) - (let ((end (set-marker (make-marker) (point-max))) - (indent-first-line-p yas/also-auto-indent-first-line) - (snippet-markers (yas/collect-snippet-markers snippet))) - (save-restriction - (widen) - ;; XXX: Here seems to be the indent problem: - ;; - ;; `indent-according-to-mode' uses whatever - ;; `indent-line-function' is available. Some - ;; implementations of these functions delete text - ;; before they insert. If there happens to be a marker - ;; just after the text being deleted, the insertion - ;; actually happens after the marker, which misplaces - ;; it. - ;; - ;; This would also happen if we had used overlays with - ;; the `front-advance' property set to nil. - ;; - (while (and (zerop (if indent-first-line-p - (prog1 - (forward-line 0) - (setq indent-first-line-p nil)) - (forward-line 1))) - (not (eobp)) - (<= (point) end)) - (goto-char (yas/real-line-beginning)) - (let ((trouble-markers (remove-if-not #'(lambda (marker) - (= marker (point))) - snippet-markers))) - (indent-according-to-mode) - (mapc #'(lambda (marker) - (set-marker marker (point))) - trouble-markers) - (indent-according-to-mode))) - (set-marker end nil)))) - (t - nil)))) + (let* ((indent (if indent-tabs-mode + (concat (make-string (/ column tab-width) ?\t) + (make-string (% column tab-width) ?\ )) + (make-string (current-column) ?\ )))) + (goto-char (point-min)) + (while (and (zerop (forward-line)) + (= (current-column) 0)) + (insert indent)))) + ((eq yas/indent-line 'auto) + (let ((end (set-marker (make-marker) (point-max))) + (indent-first-line-p yas/also-auto-indent-first-line) + (snippet-markers (yas/collect-snippet-markers snippet))) + (save-restriction + (widen) + ;; XXX: Here seems to be the indent problem: + ;; + ;; `indent-according-to-mode' uses whatever + ;; `indent-line-function' is available. Some + ;; implementations of these functions delete text + ;; before they insert. If there happens to be a marker + ;; just after the text being deleted, the insertion + ;; actually happens after the marker, which misplaces + ;; it. + ;; + ;; This would also happen if we had used overlays with + ;; the `front-advance' property set to nil. + ;; + (while (and (zerop (if indent-first-line-p + (prog1 + (forward-line 0) + (setq indent-first-line-p nil)) + (forward-line 1))) + (not (eobp)) + (<= (point) end)) + (goto-char (yas/real-line-beginning)) + (let ((trouble-markers (remove-if-not #'(lambda (marker) + (= marker (point))) + snippet-markers))) + (indent-according-to-mode) + (mapc #'(lambda (marker) + (set-marker marker (point))) + trouble-markers) + (indent-according-to-mode))) + (set-marker end nil)))) + (t + nil)))) (defun yas/collect-snippet-markers (snippet) "Make a list of all the markers used by SNIPPET." @@ -2497,12 +2689,12 @@ Meant to be called in a narrowed buffer, does various passes" (push (yas/field-start field) markers) (push (yas/field-end field) markers) (dolist (mirror (yas/field-mirrors field)) - (push (yas/mirror-start mirror) markers) - (push (yas/mirror-end mirror) markers))) + (push (yas/mirror-start mirror) markers) + (push (yas/mirror-end mirror) markers))) (let ((snippet-exit (yas/snippet-exit snippet))) (when (and snippet-exit - (marker-buffer (yas/exit-marker snippet-exit))) - (push (yas/exit-marker snippet-exit) markers))) + (marker-buffer (yas/exit-marker snippet-exit))) + (push (yas/exit-marker snippet-exit) markers))) markers)) (defun yas/real-line-beginning () @@ -2522,27 +2714,27 @@ Meant to be called in a narrowed buffer, does various passes" With optional string TEXT do it in string instead of buffer." (let ((changed-text text) - (text-provided-p text)) + (text-provided-p text)) (mapc #'(lambda (escaped) - (setq changed-text - (yas/replace-all (concat "\\" (char-to-string escaped)) - (yas/escape-string escaped) - (when text-provided-p changed-text)))) - (or escaped yas/escaped-characters)) + (setq changed-text + (yas/replace-all (concat "\\" (char-to-string escaped)) + (yas/escape-string escaped) + (when text-provided-p changed-text)))) + (or escaped yas/escaped-characters)) changed-text)) - + (defun yas/restore-escapes (&optional text escaped) "Restore all escaped characters from their numeric ASCII value. With optional string TEXT do it in string instead of the buffer." (let ((changed-text text) - (text-provided-p text)) + (text-provided-p text)) (mapc #'(lambda (escaped) - (setq changed-text - (yas/replace-all (yas/escape-string escaped) - (char-to-string escaped) - (when text-provided-p changed-text)))) - (or escaped yas/escaped-characters)) + (setq changed-text + (yas/replace-all (yas/escape-string escaped) + (char-to-string escaped) + (when text-provided-p changed-text)))) + (or escaped yas/escaped-characters)) changed-text)) (defun yas/replace-backquotes () @@ -2557,7 +2749,7 @@ With optional string TEXT do it in string instead of the buffer." (defun yas/scan-sexps (from count) (condition-case err (with-syntax-table (standard-syntax-table) - (scan-sexps from count)) + (scan-sexps from count)) (error nil))) @@ -2569,7 +2761,7 @@ With optional string TEXT do it in string instead of the buffer." (defun yas/add-to-list (l e) (setf (cdr l) - (cons e (cdr l)))) + (cons e (cdr l)))) (defun yas/field-parse-create (snippet dollar-regions &optional parent-field) "Parse most field expression, except for the simple one \"$n\". @@ -2584,91 +2776,94 @@ When multiple expressions are found, only the last one counts." (save-excursion (while (re-search-forward yas/field-regexp nil t) (let* ((real-match-end-0 (yas/scan-sexps (1+ (match-beginning 0)) 1)) - (number (and (match-string-no-properties 1) - (string-to-number (match-string-no-properties 1)))) - (brand-new-field (and real-match-end-0 - (not (save-match-data - (eq (string-match "$[ \t\n]*(" (match-string-no-properties 2)) 0))) - (not (and number (zerop number))) - (yas/make-field number - (yas/make-marker (match-beginning 2)) - (yas/make-marker (1- real-match-end-0)) - parent-field)))) + (number (and (match-string-no-properties 1) + (string-to-number (match-string-no-properties 1)))) + (brand-new-field (and real-match-end-0 + (not (save-match-data + (eq (string-match "$[ \t\n]*(" + (match-string-no-properties 2)) 0))) + (not (and number (zerop number))) + (yas/make-field number + (yas/make-marker (match-beginning 2)) + (yas/make-marker (1- real-match-end-0)) + parent-field)))) (when brand-new-field - (yas/add-to-list dollar-regions - (cons (1- real-match-end-0) real-match-end-0)) - (yas/add-to-list dollar-regions - (cons (match-beginning 0) (match-beginning 2))) - (push brand-new-field (yas/snippet-fields snippet)) - (save-excursion - (save-restriction - (narrow-to-region (yas/field-start brand-new-field) (yas/field-end brand-new-field)) - (goto-char (point-min)) - (yas/field-parse-create snippet dollar-regions brand-new-field))))))) + (yas/add-to-list dollar-regions + (cons (1- real-match-end-0) real-match-end-0)) + (yas/add-to-list dollar-regions + (cons (match-beginning 0) (match-beginning 2))) + (push brand-new-field (yas/snippet-fields snippet)) + (save-excursion + (save-restriction + (narrow-to-region (yas/field-start brand-new-field) (yas/field-end brand-new-field)) + (goto-char (point-min)) + (yas/field-parse-create snippet dollar-regions brand-new-field))))))) (when parent-field (save-excursion (while (re-search-forward yas/multi-dollar-lisp-expression-regexp nil t) (let* ((real-match-end-1 (yas/scan-sexps (match-beginning 1) 1))) - (when real-match-end-1 - (let ((lisp-expression-string (buffer-substring-no-properties (match-beginning 1) real-match-end-1))) - (setf (yas/field-transform parent-field) (yas/restore-escapes lisp-expression-string))) - (yas/add-to-list dollar-regions - (cons (match-beginning 0) real-match-end-1)))))))) + (when real-match-end-1 + (let ((lisp-expression-string (buffer-substring-no-properties (match-beginning 1) + real-match-end-1))) + (setf (yas/field-transform parent-field) (yas/restore-escapes lisp-expression-string))) + (yas/add-to-list dollar-regions + (cons (match-beginning 0) real-match-end-1)))))))) (defun yas/transform-mirror-parse-create (snippet dollar-regions) "Parse the \"${n:$(lisp-expression)}\" mirror transformations." (while (re-search-forward yas/transform-mirror-regexp nil t) (let* ((real-match-end-0 (yas/scan-sexps (1+ (match-beginning 0)) 1)) - (number (string-to-number (match-string-no-properties 1))) - (field (and number - (not (zerop number)) - (yas/snippet-find-field snippet number)))) + (number (string-to-number (match-string-no-properties 1))) + (field (and number + (not (zerop number)) + (yas/snippet-find-field snippet number)))) (when (and real-match-end-0 - field) + field) (push (yas/make-mirror (yas/make-marker (match-beginning 0)) - (yas/make-marker (match-beginning 0)) - (yas/restore-escapes (buffer-substring-no-properties (match-beginning 2) - (1- real-match-end-0)))) - (yas/field-mirrors field)) + (yas/make-marker (match-beginning 0)) + (yas/restore-escapes + (buffer-substring-no-properties (match-beginning 2) + (1- real-match-end-0)))) + (yas/field-mirrors field)) (yas/add-to-list dollar-regions - (cons (match-beginning 0) real-match-end-0)))))) + (cons (match-beginning 0) real-match-end-0)))))) (defun yas/simple-mirror-parse-create (snippet dollar-regions) "Parse the simple \"$n\" mirrors and the exit-marker." (while (re-search-forward yas/simple-mirror-regexp nil t) (let ((number (string-to-number (match-string-no-properties 1)))) (cond ((zerop number) - - (setf (yas/snippet-exit snippet) - (yas/make-exit (yas/make-marker (match-end 0)))) - (save-excursion - (goto-char (match-beginning 0)) - (when (and yas/wrap-around-region yas/selected-text) - (insert yas/selected-text)) - (yas/add-to-list dollar-regions - (cons (point) (yas/exit-marker (yas/snippet-exit snippet)))))) - (t - (let ((field (yas/snippet-find-field snippet number))) - (if field - (push (yas/make-mirror (yas/make-marker (match-beginning 0)) - (yas/make-marker (match-beginning 0)) - nil) - (yas/field-mirrors field)) - (push (yas/make-field number - (yas/make-marker (match-beginning 0)) - (yas/make-marker (match-beginning 0)) - nil) - (yas/snippet-fields snippet)))) - (yas/add-to-list dollar-regions - (cons (match-beginning 0) (match-end 0)))))))) + + (setf (yas/snippet-exit snippet) + (yas/make-exit (yas/make-marker (match-end 0)))) + (save-excursion + (goto-char (match-beginning 0)) + (when (and yas/wrap-around-region yas/selected-text) + (insert yas/selected-text)) + (yas/add-to-list dollar-regions + (cons (point) (yas/exit-marker (yas/snippet-exit snippet)))))) + (t + (let ((field (yas/snippet-find-field snippet number))) + (if field + (push (yas/make-mirror (yas/make-marker (match-beginning 0)) + (yas/make-marker (match-beginning 0)) + nil) + (yas/field-mirrors field)) + (push (yas/make-field number + (yas/make-marker (match-beginning 0)) + (yas/make-marker (match-beginning 0)) + nil) + (yas/snippet-fields snippet)))) + (yas/add-to-list dollar-regions + (cons (match-beginning 0) (match-end 0)))))))) (defun yas/delete-regions (regions) "Sort disjuct REGIONS by start point, then delete from the back." (mapc #'(lambda (reg) - (delete-region (car reg) (cdr reg))) - (sort regions - #'(lambda (r1 r2) - (>= (car r1) (car r2)))))) + (delete-region (car reg) (cdr reg))) + (sort regions + #'(lambda (r1 r2) + (>= (car r1) (car r2)))))) (defun yas/update-mirrors (snippet) "Updates all the mirrors of SNIPPET." @@ -2678,26 +2873,27 @@ When multiple expressions are found, only the last one counts." ;; stacked expansion: I added an `inhibit-modification-hooks' ;; here, for safety, may need to remove if we the mechanism is ;; altered. - ;; + ;; (let ((inhibit-modification-hooks t)) - (yas/mirror-update-display mirror field) - ;; `yas/place-overlays' is needed if the active field and - ;; protected overlays have been changed because of insertions - ;; in `yas/mirror-update-display' - ;; - (when (eq field (yas/snippet-active-field snippet)) - (yas/place-overlays snippet field))))))) + (yas/mirror-update-display mirror field) + ;; `yas/place-overlays' is needed if the active field and + ;; protected overlays have been changed because of insertions + ;; in `yas/mirror-update-display' + ;; + (when (eq field (yas/snippet-active-field snippet)) + (yas/place-overlays snippet field))))))) (defun yas/mirror-update-display (mirror field) "Update MIRROR according to FIELD (and mirror transform)." (let ((reflection (or (yas/apply-transform mirror field) - (yas/field-text-for-display field)))) + (yas/field-text-for-display field)))) (when (and reflection - (not (string= reflection (buffer-substring-no-properties (yas/mirror-start mirror) (yas/mirror-end mirror))))) + (not (string= reflection (buffer-substring-no-properties (yas/mirror-start mirror) + (yas/mirror-end mirror))))) (goto-char (yas/mirror-start mirror)) (insert reflection) (if (> (yas/mirror-end mirror) (point)) - (delete-region (point) (yas/mirror-end mirror)) + (delete-region (point) (yas/mirror-end mirror)) (set-marker (yas/mirror-end mirror) (point)) (yas/advance-start-maybe (yas/mirror-next mirror) (point)))))) @@ -2705,46 +2901,47 @@ When multiple expressions are found, only the last one counts." "Much like `yas/mirror-update-display', but for fields" (when (yas/field-transform field) (let ((inhibit-modification-hooks t) - (transformed (yas/apply-transform field field)) - (point (point))) + (transformed (yas/apply-transform field field)) + (point (point))) (when (and transformed - (not (string= transformed (buffer-substring-no-properties (yas/field-start field) (yas/field-end field))))) + (not (string= transformed (buffer-substring-no-properties (yas/field-start field) + (yas/field-end field))))) (setf (yas/field-modified-p field) t) (goto-char (yas/field-start field)) (insert transformed) (if (> (yas/field-end field) (point)) - (delete-region (point) (yas/field-end field)) - (set-marker (yas/field-end field) (point)) - (yas/advance-start-maybe (yas/field-next field) (point))) + (delete-region (point) (yas/field-end field)) + (set-marker (yas/field-end field) (point)) + (yas/advance-start-maybe (yas/field-next field) (point))) t)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Pre- and post-command hooks -;; +;; (defun yas/pre-command-handler () ) (defun yas/post-command-handler () "Handles various yasnippet conditions after each command." (cond (yas/protection-violation - (goto-char yas/protection-violation) - (setq yas/protection-violation nil)) - ((eq 'undo this-command) - ;; - ;; After undo revival the correct field is sometimes not - ;; restored correctly, this condition handles that - ;; - (let* ((snippet (car (yas/snippets-at-point))) - (target-field (and snippet - (find-if-not #'(lambda (field) - (yas/field-probably-deleted-p snippet field)) - (remove nil - (cons (yas/snippet-active-field snippet) - (yas/snippet-fields snippet))))))) - (when target-field - (yas/move-to-field snippet target-field)))) - ((not (yas/undo-in-progress)) - ;; When not in an undo, check if we must commit the snippet (use exited it). - (yas/check-commit-snippet)))) + (goto-char yas/protection-violation) + (setq yas/protection-violation nil)) + ((eq 'undo this-command) + ;; + ;; After undo revival the correct field is sometimes not + ;; restored correctly, this condition handles that + ;; + (let* ((snippet (car (yas/snippets-at-point))) + (target-field (and snippet + (find-if-not #'(lambda (field) + (yas/field-probably-deleted-p snippet field)) + (remove nil + (cons (yas/snippet-active-field snippet) + (yas/snippet-fields snippet))))))) + (when target-field + (yas/move-to-field snippet target-field)))) + ((not (yas/undo-in-progress)) + ;; When not in an undo, check if we must commit the snippet (use exited it). + (yas/check-commit-snippet)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Debug functions. Use (or change) at will whenever needed. @@ -2754,12 +2951,29 @@ When multiple expressions are found, only the last one counts." ;; (insert (pp ;; (let ((shit)) ;; (maphash #'(lambda (k v) -;; (push k shit)) -;; (yas/snippet-table-hash (gethash 'ruby-mode yas/snippet-tables))) +;; (push k shit)) +;; (yas/snippet-table-hash (gethash 'ruby-mode yas/snippet-tables))) ;; shit))) ;; -(defun yas/debug-some-vars () +(defun yas/debug-tables () + (interactive) + (with-output-to-temp-buffer "*YASnippet tables*" + (dolist (symbol (remove nil (append (list major-mode) + (if (listp yas/mode-symbol) + yas/mode-symbol + (list yas/mode-symbol))))) + (princ (format "Snippet table hash keys for %s:\n\n" symbol)) + (let ((keys)) + (maphash #'(lambda (k v) + (push k keys)) + (yas/snippet-table-hash (gethash symbol yas/snippet-tables))) + (princ keys)) + + (princ (format "Keymap for %s:\n\n" symbol)) + (princ (gethash symbol yas/menu-table))))) + +(defun yas/debug-snippet-vars () "Debug snippets, fields, mirrors and the `buffer-undo-list'." (interactive) (with-output-to-temp-buffer "*YASnippet trace*" @@ -2771,62 +2985,62 @@ When multiple expressions are found, only the last one counts." (princ (format "%s live snippets in total\n" (length (yas/snippets-at-point (quote all-snippets))))) (princ (format "%s overlays in buffer:\n\n" (length (overlays-in (point-min) (point-max))))) (princ (format "%s live snippets at point:\n\n" (length (yas/snippets-at-point)))) - - + + (dolist (snippet (yas/snippets-at-point)) (princ (format "\tsid: %d control overlay from %d to %d\n" - (yas/snippet-id snippet) - (overlay-start (yas/snippet-control-overlay snippet)) - (overlay-end (yas/snippet-control-overlay snippet)))) + (yas/snippet-id snippet) + (overlay-start (yas/snippet-control-overlay snippet)) + (overlay-end (yas/snippet-control-overlay snippet)))) (princ (format "\tactive field: %d from %s to %s covering \"%s\"\n" - (yas/field-number (yas/snippet-active-field snippet)) - (marker-position (yas/field-start (yas/snippet-active-field snippet))) - (marker-position (yas/field-end (yas/snippet-active-field snippet))) - (buffer-substring-no-properties (yas/field-start (yas/snippet-active-field snippet)) (yas/field-end (yas/snippet-active-field snippet))))) + (yas/field-number (yas/snippet-active-field snippet)) + (marker-position (yas/field-start (yas/snippet-active-field snippet))) + (marker-position (yas/field-end (yas/snippet-active-field snippet))) + (buffer-substring-no-properties (yas/field-start (yas/snippet-active-field snippet)) (yas/field-end (yas/snippet-active-field snippet))))) (when (yas/snippet-exit snippet) - (princ (format "\tsnippet-exit: at %s next: %s\n" - (yas/exit-marker (yas/snippet-exit snippet)) - (yas/exit-next (yas/snippet-exit snippet))))) + (princ (format "\tsnippet-exit: at %s next: %s\n" + (yas/exit-marker (yas/snippet-exit snippet)) + (yas/exit-next (yas/snippet-exit snippet))))) (dolist (field (yas/snippet-fields snippet)) - (princ (format "\tfield: %d from %s to %s covering \"%s\" next: %s\n" - (yas/field-number field) - (marker-position (yas/field-start field)) - (marker-position (yas/field-end field)) - (buffer-substring-no-properties (yas/field-start field) (yas/field-end field)) - (yas/debug-format-fom-concise (yas/field-next field)))) - (dolist (mirror (yas/field-mirrors field)) - (princ (format "\t\tmirror: from %s to %s covering \"%s\" next: %s\n" - (marker-position (yas/mirror-start mirror)) - (marker-position (yas/mirror-end mirror)) - (buffer-substring-no-properties (yas/mirror-start mirror) (yas/mirror-end mirror)) - (yas/debug-format-fom-concise (yas/mirror-next mirror))))))) + (princ (format "\tfield: %d from %s to %s covering \"%s\" next: %s\n" + (yas/field-number field) + (marker-position (yas/field-start field)) + (marker-position (yas/field-end field)) + (buffer-substring-no-properties (yas/field-start field) (yas/field-end field)) + (yas/debug-format-fom-concise (yas/field-next field)))) + (dolist (mirror (yas/field-mirrors field)) + (princ (format "\t\tmirror: from %s to %s covering \"%s\" next: %s\n" + (marker-position (yas/mirror-start mirror)) + (marker-position (yas/mirror-end mirror)) + (buffer-substring-no-properties (yas/mirror-start mirror) (yas/mirror-end mirror)) + (yas/debug-format-fom-concise (yas/mirror-next mirror))))))) (princ (format "\nUndo is %s and point-max is %s.\n" - (if (eq buffer-undo-list t) - "DISABLED" - "ENABLED") - (point-max))) + (if (eq buffer-undo-list t) + "DISABLED" + "ENABLED") + (point-max))) (unless (eq buffer-undo-list t) (princ (format "Undpolist has %s elements. First 10 elements follow:\n" (length buffer-undo-list))) (let ((first-ten (subseq buffer-undo-list 0 19))) - (dolist (undo-elem first-ten) - (princ (format "%2s: %s\n" (position undo-elem first-ten) (truncate-string-to-width (format "%s" undo-elem) 70)))))))) + (dolist (undo-elem first-ten) + (princ (format "%2s: %s\n" (position undo-elem first-ten) (truncate-string-to-width (format "%s" undo-elem) 70)))))))) (defun yas/debug-format-fom-concise (fom) (when fom (cond ((yas/field-p fom) - (format "field %d from %d to %d" - (yas/field-number fom) - (marker-position (yas/field-start fom)) - (marker-position (yas/field-end fom)))) - ((yas/mirror-p fom) - (format "mirror from %d to %d" - (marker-position (yas/mirror-start fom)) - (marker-position (yas/mirror-end fom)))) - (t - (format "snippet exit at %d" - (marker-position (yas/fom-start fom))))))) - + (format "field %d from %d to %d" + (yas/field-number fom) + (marker-position (yas/field-start fom)) + (marker-position (yas/field-end fom)))) + ((yas/mirror-p fom) + (format "mirror from %d to %d" + (marker-position (yas/mirror-start fom)) + (marker-position (yas/mirror-end fom)))) + (t + (format "snippet exit at %d" + (marker-position (yas/fom-start fom))))))) + (defun yas/exterminate-package () (interactive) @@ -2839,9 +3053,9 @@ When multiple expressions are found, only the last one counts." (defun yas/debug-test (&optional quiet) (interactive "P") (yas/load-directory (or (and (listp yas/root-directory) - (first yas/root-directory)) - yas/root-directory - "~/Source/yasnippet/snippets/")) + (first yas/root-directory)) + yas/root-directory + "~/Source/yasnippet/snippets/")) (set-buffer (switch-to-buffer "*YAS TEST*")) (mapc #'yas/commit-snippet (yas/snippets-at-point 'all-snippets)) (erase-buffer) @@ -2853,7 +3067,7 @@ When multiple expressions are found, only the last one counts." (setq abbrev "$f") (insert abbrev)) (unless quiet - (add-hook 'post-command-hook 'yas/debug-some-vars 't 'local))) + (add-hook 'post-command-hook 'yas/debug-snippet-vars 't 'local))) (provide 'yasnippet) @@ -2875,10 +3089,10 @@ handle the end-of-buffer error fired in it by calling ;; disable c-electric-* serial command in YAS fields (add-hook 'c-mode-common-hook '(lambda () - (make-variable-buffer-local 'yas/keymap) - (dolist (k '(":" ">" ";" "<" "{" "}")) - (define-key yas/keymap - k 'self-insert-command)))) + (make-variable-buffer-local 'yas/keymap) + (dolist (k '(":" ">" ";" "<" "{" "}")) + (define-key yas/keymap + k 'self-insert-command)))) ;;; yasnippet.el ends here