ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-14 05:23:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

* Implement per-snippet keybinding using "keybinding: " keyword

Browse Source 
* Fix random bugs
* Fix some whitespace
* `yas/use-menu' can now be 'real-modes' or 'abbreviate'

* Changed prototype of `yas/expand-snippet' to be more user-friendly
  (this breaks backward compatibility)
* Renamed keyword "env" to "expand-env"

* TODO: fix more bugs, write more documentation
This commit is contained in:
capitaomorte 2009-08-11 14:33:06 +00:00
parent 4cc4d0c578
commit d153d84010
1 changed files with 1153 additions and 939 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

434
yasnippet.el
View File

@ -118,7 +118,7 @@
;; your .emacs file, for example: ;; your .emacs file, for example:
;; ;;
;; (require 'dropdown-list) ;; (require 'dropdown-list)
;; (setq 'yas/prompt-functions '(yas/dropdown-prompt ;; (setq yas/prompt-functions '(yas/dropdown-prompt
;; yas/ido-prompt ;; yas/ido-prompt
;; yas/completing-prompt)) ;; yas/completing-prompt))
;; ;;
@ -132,6 +132,7 @@
;;; Code: ;;; Code:
(require 'cl) (require 'cl)
(require 'assoc)
(require 'easymenu) (require 'easymenu)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -252,9 +253,9 @@ arguments."
:group 'yasnippet) :group 'yasnippet)
(defcustom yas/choose-keys-first t (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'." This affects `yas/insert-snippet' and `yas/visit-snippet-file'."
:type 'boolean :type 'boolean
@ -270,13 +271,21 @@ This affects `yas/insert-snippet', `yas/visit-snippet-file'"
:type 'boolean :type 'boolean
:group 'yasnippet) :group 'yasnippet)
(defcustom yas/use-menu t (defcustom yas/use-menu 'real-modes
"Display a YASnippet menu in the menu bar. "Display a YASnippet menu in the menu bar.
When non-nil, snippet templates will be listed under the menu When non-nil, submenus for each snippet table will be listed
\"Yasnippet\". If set to `abbreviate', only the current major-mode under the menu \"Yasnippet\".
menu and the modes set in `yas/mode-symbol' are listed."
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) :type '(choice (const :tag "Full" t)
(const :tag "Real modes only" real-modes)
(const :tag "Abbreviate" abbreviate)) (const :tag "Abbreviate" abbreviate))
:group 'yasnippet) :group 'yasnippet)
@ -411,14 +420,16 @@ Here's an example:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal variables ;; Internal variables
;; ;;
(defvar yas/version "0.6.1b")
(defvar yas/version "0.6.0b")
(defvar yas/snippet-tables (make-hash-table) (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) (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 (defvar yas/known-modes
'(ruby-mode rst-mode markdown-mode) '(ruby-mode rst-mode markdown-mode)
@ -463,12 +474,12 @@ Here's an example:
(defvar last-buffer-undo-list nil) (defvar last-buffer-undo-list nil)
(defvar yas/minor-mode-map (make-sparse-keymap) (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) (defvar yas/minor-mode-menu (make-sparse-keymap)
"Holds the YASnippet menu. For use with `easy-menu-define'.") "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 (easy-menu-define yas/minor-mode-menu
yas/minor-mode-map yas/minor-mode-map
"Menu used when YAS/minor-mode is active." "Menu used when YAS/minor-mode is active."
@ -478,13 +489,19 @@ Here's an example:
(define-key yas/minor-mode-map (third ent) (second ent))) (define-key yas/minor-mode-map (third ent) (second ent)))
(vector (first ent) (second ent) t)) (vector (first ent) (second ent) t))
(list (list "--") (list (list "--")
(list "Expand trigger" 'yas/expand (when yas/trigger-key (read-kbd-macro yas/trigger-key))) (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 "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 "Visit snippet file..." 'yas/visit-snippet-file "\C-c&\C-v")
(list "Find snippets..." 'yas/find-snippets "\C-c&\C-f") (list "Find snippets..." 'yas/find-snippets "\C-c&\C-f")
(list "About" 'yas/about) (list "--")
(list "Reload-all-snippets" 'yas/reload-all) (list "Load snippets..." 'yas/load-directory)
(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 (define-minor-mode yas/minor-mode
"Toggle YASnippet mode. "Toggle YASnippet mode.
@ -507,11 +524,11 @@ Key bindings:
(when yas/minor-mode (when yas/minor-mode
;; when turning on theminor mode, re-read the `yas/trigger-key' ;; when turning on theminor mode, re-read the `yas/trigger-key'
;; if a `yas/minor-mode-map' is already built. Else, call ;; 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) (if (and (cdr yas/minor-mode-map)
yas/trigger-key) yas/trigger-key)
(define-key yas/minor-mode-map (read-kbd-macro yas/trigger-key) 'yas/expand) (define-key yas/minor-mode-map (read-kbd-macro yas/trigger-key) 'yas/expand)
(yas/init-keymap-and-menu)))) (yas/init-minor-keymap))))
(defun yas/minor-mode-on () (defun yas/minor-mode-on ()
"Turn on YASnippet minor mode." "Turn on YASnippet minor mode."
@ -546,17 +563,36 @@ Key bindings:
("}" ("}"
(0 font-lock-keyword-face))))) (0 font-lock-keyword-face)))))
(defvar snippet-mode-map (make-sparse-keymap)) (defvar snippet-mode-map (make-sparse-keymap)
(define-key snippet-mode-map "\C-c\C-c" 'yas/load-snippet-buffer) "The keymap used when `snippet-mode' is active")
(define-key snippet-mode-map "\C-c\C-t" 'yas/tryout-snippet)
(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" "A mode for editing yasnippets"
(set-syntax-table (standard-syntax-table)) (set-syntax-table (standard-syntax-table))
(setq font-lock-defaults '(yas/font-lock-keywords)) (setq font-lock-defaults '(yas/font-lock-keywords))
(set (make-local-variable 'require-final-newline) nil) (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)))
@ -565,16 +601,17 @@ Key bindings:
;; ;;
(defstruct (yas/template (:constructor yas/make-template (defstruct (yas/template (:constructor yas/make-template
(content name condition env file))) (content name condition env file keybinding)))
"A template for a snippet." "A template for a snippet."
content content
name name
condition condition
env env
file) file
keybinding)
(defstruct (yas/snippet-table (:constructor yas/make-snippet-table (name))) (defstruct (yas/snippet-table (:constructor yas/make-snippet-table (name)))
"A table to store snippets for a perticular mode." "A table to store snippets for a particular mode."
name name
(hash (make-hash-table :test 'equal)) (hash (make-hash-table :test 'equal))
(parents nil)) (parents nil))
@ -642,6 +679,19 @@ This function implements the rules described in
(defun yas/snippet-table-store (table full-key key template) (defun yas/snippet-table-store (table full-key key template)
"Store a snippet template in the TABLE." "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 (puthash key
(yas/modify-alist (gethash key (yas/modify-alist (gethash key
(yas/snippet-table-hash table)) (yas/snippet-table-hash table))
@ -792,7 +842,8 @@ Here's a list of currently recognized variables:
bound bound
condition condition
group group
env) env
binding)
(if (re-search-forward "^# --\n" nil t) (if (re-search-forward "^# --\n" nil t)
(progn (setq template (progn (setq template
(buffer-substring-no-properties (point) (buffer-substring-no-properties (point)
@ -806,13 +857,15 @@ Here's a list of currently recognized variables:
(setq condition (read (match-string-no-properties 2)))) (setq condition (read (match-string-no-properties 2))))
(when (string= "group" (match-string-no-properties 1)) (when (string= "group" (match-string-no-properties 1))
(setq group (match-string-no-properties 2))) (setq group (match-string-no-properties 2)))
(when (string= "env" (match-string-no-properties 1)) (when (string= "expand-env" (match-string-no-properties 1))
(setq env (match-string-no-properties 2))) (setq env (match-string-no-properties 2)))
(when (string= "key" (match-string-no-properties 1)) (when (string= "key" (match-string-no-properties 1))
(setq key (match-string-no-properties 2))))) (setq key (match-string-no-properties 2)))
(when (string= "binding" (match-string-no-properties 1))
(setq binding (match-string-no-properties 2)))))
(setq template (setq template
(buffer-substring-no-properties (point-min) (point-max)))) (buffer-substring-no-properties (point-min) (point-max))))
(list key template name condition group env file))) (list key template name condition group env file binding)))
(defun yas/subdirs (directory &optional file?) (defun yas/subdirs (directory &optional file?)
"Return subdirs or files of DIRECTORY according to FILE?." "Return subdirs or files of DIRECTORY according to FILE?."
@ -833,9 +886,9 @@ Here's a list of currently recognized variables:
(let ((where (if mark-active (let ((where (if mark-active
(cons (region-beginning) (region-end)) (cons (region-beginning) (region-end))
(cons (point) (point))))) (cons (point) (point)))))
(yas/expand-snippet (car where) (yas/expand-snippet (yas/template-content template)
(cdr where) (car where)
(yas/template-content template)))) (cdr where))))
(defun yas/modify-alist (alist key value) (defun yas/modify-alist (alist key value)
"Modify ALIST to map KEY to VALUE. return the new alist." "Modify ALIST to map KEY to VALUE. return the new alist."
@ -975,32 +1028,52 @@ content of the file is the template."
(interactive "DSelect the root directory: ") (interactive "DSelect the root directory: ")
(unless (file-directory-p directory) (unless (file-directory-p directory)
(error "Error %s not a directory" 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)) (dolist (dir (yas/subdirs directory))
(yas/load-directory-1 dir nil 'no-hierarchy-parents)) (yas/load-directory-1 dir nil 'no-hierarchy-parents))
(when (interactive-p) (when (interactive-p)
(message "done."))) (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 () (defun yas/reload-all ()
"Reload all snippets and rebuild the YASnippet menu. " "Reload all snippets and rebuild the YASnippet menu. "
(interactive) (interactive)
(let ((restore-global-mode nil) ;; Turn off global modes and minor modes, save their state though
(restore-minor-mode nil)) ;;
(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/snippet-tables (make-hash-table))
(setq yas/menu-table (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-menu) nil)
(setf (cdr yas/minor-mode-map) nil) (setf (cdr yas/minor-mode-map) nil)
(when yas/global-mode (setf (cdr yas/major-mode-menu) nil)
(yas/global-mode -1) (setf (cdr snippet-mode-map) nil)
(setq restore-global-mode t))
(when yas/minor-mode ;; Initialize both keymaps
(yas/minor-mode -1) ;;
(setq restore-minor-mode t)) (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 yas/root-directory
(if (listp yas/root-directory) (if (listp yas/root-directory)
(dolist (directory yas/root-directory) (dolist (directory yas/root-directory)
@ -1008,10 +1081,10 @@ content of the file is the template."
(yas/load-directory yas/root-directory)) (yas/load-directory yas/root-directory))
(call-interactively 'yas/load-directory)) (call-interactively 'yas/load-directory))
;; Restore the mode configuration
;;
(when restore-minor-mode (when restore-minor-mode
(yas/minor-mode 1)) (yas/minor-mode 1))
(when restore-global-mode (when restore-global-mode
(yas/global-mode 1)) (yas/global-mode 1))
@ -1144,12 +1217,14 @@ Here's the default value for all the parameters:
") -- pluskid <pluskid@gmail.com>/joaotavora <joaotavora@gmail.com>"))) ") -- pluskid <pluskid@gmail.com>/joaotavora <joaotavora@gmail.com>")))
(defun yas/define-snippets (mode snippets &optional parent-mode) (defun yas/define-snippets (mode snippets &optional parent-mode)
"Define snippets for MODE. SNIPPETS is a list of "Define SNIPPETS for MODE.
snippet definitions, each taking the following form:
(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 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 MODE. It can be a mode symbol of a list of mode symbols. It does
@ -1165,6 +1240,8 @@ its parent modes."
(keymap (if yas/use-menu (keymap (if yas/use-menu
(yas/menu-keymap-get-create mode) (yas/menu-keymap-get-create mode)
nil))) nil)))
;; Setup the menu
;;
(when parent-tables (when parent-tables
(setf (yas/snippet-table-parents snippet-table) (setf (yas/snippet-table-parents snippet-table)
parent-tables) parent-tables)
@ -1176,35 +1253,81 @@ its parent modes."
parent-mode) parent-mode)
'((parent-mode . "parent mode"))))) '((parent-mode . "parent mode")))))
(mapc #'(lambda (sym-and-name) (mapc #'(lambda (sym-and-name)
(define-key keymap (vector (intern (replace-regexp-in-string " " "_" (cdr sym-and-name)))) (define-key keymap
(vector (intern (replace-regexp-in-string " " "_" (cdr sym-and-name))))
(list 'menu-item (cdr sym-and-name) (list 'menu-item (cdr sym-and-name)
(yas/menu-keymap-get-create (car sym-and-name))))) (yas/menu-keymap-get-create (car sym-and-name)))))
(reverse parent-menu-syms-and-names))))) (reverse parent-menu-syms-and-names)))))
(when (and yas/use-menu (when yas/use-menu
(yas/real-mode? mode))
(define-key yas/minor-mode-menu (vector mode) (define-key yas/minor-mode-menu (vector mode)
`(menu-item ,(symbol-name mode) ,keymap `(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) (dolist (snippet snippets)
(let* ((full-key (car snippet)) (let* ((full-key (car snippet))
(key (file-name-sans-extension full-key)) (key (file-name-sans-extension full-key))
(name (or (nth 2 snippet) (file-name-extension full-key))) (name (or (third snippet) (file-name-extension full-key)))
(condition (nth 3 snippet)) (condition (fourth snippet))
(group (nth 4 snippet)) (group (fifth snippet))
(template (yas/make-template (nth 1 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) (or name key)
condition condition
(nth 5 snippet) (sixth snippet)
(nth 6 snippet)))) (seventh snippet)
keybinding))
(yas/snippet-table-store snippet-table (yas/snippet-table-store snippet-table
full-key full-key
key key
template) 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 (when yas/use-menu
(let ((group-keymap keymap)) (let ((group-keymap keymap))
;; delete this entry from another group if already exists ;; Delete this entry from another group if already exists
;; in some other group. An entry is considered as existing ;; in some other group. An entry is considered as existing
;; in another group if its name string-matches. ;; in another group if its name string-matches.
;;
(yas/delete-from-keymap group-keymap name) (yas/delete-from-keymap group-keymap name)
;; ... then add this entry to the correct group ;; ... then add this entry to the correct group
@ -1227,11 +1350,15 @@ its parent modes."
(defun yas/show-menu-p (mode) (defun yas/show-menu-p (mode)
(message "what") (message "what")
(or (not (eq yas/use-menu 'abbreviate)) (cond ((eq yas/use-menu 'abbreviate)
(find mode (cons major-mode (find mode (cons major-mode
(if (listp yas/mode-symbol) (if (listp yas/mode-symbol)
yas/mode-symbol yas/mode-symbol
(list 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) (defun yas/delete-from-keymap (keymap name)
"Recursively delete items name NAME from KEYMAP and its submenus. "Recursively delete items name NAME from KEYMAP and its submenus.
@ -1250,7 +1377,8 @@ Skip any submenus named \"parent mode\""
;; ;;
(when (keymapp keymap) (when (keymapp keymap)
(let ((pos-in-keymap)) (let ((pos-in-keymap))
(while (setq pos-in-keymap (position-if #'(lambda (item) (while (setq pos-in-keymap
(position-if #'(lambda (item)
(and (listp item) (and (listp item)
(or (or
;; the menu item we want to delete ;; the menu item we want to delete
@ -1260,7 +1388,8 @@ Skip any submenus named \"parent mode\""
;; a stale subgroup ;; a stale subgroup
(and (keymapp (fourth item)) (and (keymapp (fourth item))
(not (and (stringp (third item)) (not (and (stringp (third item))
(string-match "parent mode" (third item)))) (string-match "parent mode"
(third item))))
(null (rest (fourth item))))))) (null (rest (fourth item)))))))
keymap)) keymap))
(setf (nthcdr pos-in-keymap keymap) (setf (nthcdr pos-in-keymap keymap)
@ -1320,9 +1449,9 @@ defined in `yas/fallback-behavior'"
(yas/prompt-for-template (mapcar #'cdr templates))) (yas/prompt-for-template (mapcar #'cdr templates)))
(cdar templates)))) (cdar templates))))
(when template (when template
(yas/expand-snippet start (yas/expand-snippet (yas/template-content template)
start
end end
(yas/template-content template)
(yas/template-env template)))) (yas/template-env template))))
(cond ((eq yas/fallback-behavior 'return-nil) (cond ((eq yas/fallback-behavior 'return-nil)
;; return nil ;; return nil
@ -1382,9 +1511,9 @@ by condition."
(cons (region-beginning) (region-end)) (cons (region-beginning) (region-end))
(cons (point) (point))))) (cons (point) (point)))))
(if template (if template
(yas/expand-snippet (car where) (yas/expand-snippet (yas/template-content template)
(car where)
(cdr where) (cdr where)
(yas/template-content template)
(yas/template-env template)) (yas/template-env template))
(message "[yas] No snippets can be inserted here!")))) (message "[yas] No snippets can be inserted here!"))))
@ -1427,14 +1556,15 @@ also the current active tables."
;; Next lookup the main active table ;; Next lookup the main active table
;; ;;
(let ((active-tables (first (yas/get-snippet-tables))) (let ((active-tables (first (yas/get-snippet-tables)))
(other-path-alternative main-dir)) other-path-alternative)
(when active-tables (when active-tables
(setq active-tables (cons active-tables (setq active-tables (cons active-tables
(yas/snippet-table-get-all-parents active-tables)))) (yas/snippet-table-get-all-parents active-tables))))
(dolist (table (reverse active-tables)) (dolist (table (reverse active-tables))
(setq other-path-alternative (setq other-path-alternative
(concat other-path-alternative "/" (yas/snippet-table-name table)))) (concat main-dir "/" (yas/snippet-table-name table))))
(push other-path-alternative options)) (when other-path-alternative
(push other-path-alternative options)))
;; Finally add to the options the guessed parent of major-mode ;; Finally add to the options the guessed parent of major-mode
;; (this is almost never works out) ;; (this is almost never works out)
(when (get mode 'derived-mode-parent) (when (get mode 'derived-mode-parent)
@ -1465,14 +1595,23 @@ one of these exists, it is taken and `find-file' is called there,
otherwise, proposes to create the first option returned by otherwise, proposes to create the first option returned by
`yas/guess-directory'." `yas/guess-directory'."
(interactive "P") (interactive "P")
(let* ((guessed-directories (yas/guess-snippet-directory)) (let* ((guessed-directories (append (yas/guess-snippet-directory)
(target-directory (first (remove-if-not #'file-exists-p guessed-directories))) (if (listp yas/root-directory)
yas/root-directory
(list yas/root-directory))))
(target-directory (first guessed-directories))
(buffer)) (buffer))
(unless target-directory (while (and guessed-directories
(when (y-or-n-p (format "Guessed directory (%s) does not exist! Create? " (first 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)) (setq target-directory (first guessed-directories))
(make-directory target-directory 'also-make-parents))) (make-directory target-directory 'also-make-parents))
(setq guessed-directories (cdr guessed-directories))
(setq target-directory (first guessed-directories))))
(when target-directory (when target-directory
(let ((default-directory target-directory)) (let ((default-directory target-directory))
@ -1502,7 +1641,8 @@ otherwise, proposes to create the first option returned by
(major-mode-sym (or (and major-mode-name (major-mode-sym (or (and major-mode-name
(intern major-mode-name)) (intern major-mode-name))
(when prompt-if-failed (when prompt-if-failed
(read-from-minibuffer "[yas] Cannot auto-detect major mode! Enter a major mode: ")))) (read-from-minibuffer
"[yas] Cannot auto-detect major mode! Enter a major mode: "))))
(parent-mode-sym (and parent-mode-name (parent-mode-sym (and parent-mode-name
(intern parent-mode-name))) (intern parent-mode-name)))
(extra-parents-file-name (concat file-dir "/.yas-parents")) (extra-parents-file-name (concat file-dir "/.yas-parents"))
@ -1510,7 +1650,7 @@ otherwise, proposes to create the first option returned by
(mapcar #'intern (mapcar #'intern
(split-string (split-string
(with-temp-buffer (with-temp-buffer
(insert-file extra-parents-file-name) (insert-file-contents extra-parents-file-name)
(buffer-substring-no-properties (point-min) (buffer-substring-no-properties (point-min)
(point-max)))))))) (point-max))))))))
(when major-mode-sym (when major-mode-sym
@ -1537,7 +1677,9 @@ With optional prefix argument KILL quit the window and buffer."
(save-buffer)) (save-buffer))
(if kill (if kill
(quit-window kill) (quit-window kill)
(message "[yas] Snippet \"%s\" loaded for %s." name (car major-mode-and-parent))))) (message "[yas] Snippet \"%s\" loaded for %s."
name
(car major-mode-and-parent)))))
(message "[yas] Cannot load snippet for unknown major mode"))) (message "[yas] Cannot load snippet for unknown major mode")))
(message "Save the buffer as a file first!"))) (message "Save the buffer as a file first!")))
@ -1549,14 +1691,22 @@ With optional prefix argument KILL quit the window and buffer."
(fboundp (car major-mode-and-parent)) (fboundp (car major-mode-and-parent))
(yas/parse-template (symbol-name (car major-mode-and-parent))))) (yas/parse-template (symbol-name (car major-mode-and-parent)))))
(template (and parsed (template (and parsed
(yas/make-template (second parsed) (third parsed) nil (sixth parsed) nil)))) (yas/make-template (second parsed)
(third parsed)
nil
(sixth parsed)
nil
nil))))
(cond (template (cond (template
(let ((buffer-name (format "*YAS TEST: %s*" (yas/template-name template)))) (let ((buffer-name (format "*YAS TEST: %s*" (yas/template-name template))))
(set-buffer (switch-to-buffer buffer-name)) (set-buffer (switch-to-buffer buffer-name))
(erase-buffer) (erase-buffer)
(setq buffer-undo-list nil) (setq buffer-undo-list nil)
(funcall (car major-mode-and-parent)) (funcall (car major-mode-and-parent))
(yas/expand-snippet (point-min) (point-max) (yas/template-content template) (yas/template-env template)) (yas/expand-snippet (yas/template-content template)
(point-min)
(point-max)
(yas/template-env template))
(when debug (when debug
(add-hook 'post-command-hook 'yas/debug-some-vars 't 'local)))) (add-hook 'post-command-hook 'yas/debug-some-vars 't 'local))))
(t (t
@ -1621,9 +1771,13 @@ Otherwise throw exception."
(when field (when field
(yas/field-text-for-display field)))) (yas/field-text-for-display field))))
(defun yas/oni (text oni-regexp) ;; (defun yas/oni (text regexp format &optional options)
"Runs ruby to parse TEXT with Oniguruma regexp ONI-REGEXP." ;; "Pipes TEXT thru ruby Oniguruma regexp"
(shell-command-to-string (format "ruby -e 'print \"%s\".gsub(\"a\",\"b\")'" "aha"))) ;; (replace-regexp-in-string
;; "\n$"
;; ""
;; (shell-command-to-string (format "ruby -e 'puts \"%s\".gsub(\"a\",\"b\")'" text))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1834,6 +1988,15 @@ Also create some protection overlays"
(yas/exit-marker (yas/snippet-exit snippet)) (yas/exit-marker (yas/snippet-exit snippet))
(overlay-end (yas/snippet-control-overlay 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: ;;; Apropos markers-to-points:
;;; ;;;
;;; This was found useful for performance reasons, so that an ;;; This was found useful for performance reasons, so that an
@ -1875,14 +2038,19 @@ the original marker object with the position set to nil."
"Convert all cons (POINT . MARKER) in SNIPPET to markers. This "Convert all cons (POINT . MARKER) in SNIPPET to markers. This
is done by setting MARKER to POINT with `set-marker'." is done by setting MARKER to POINT with `set-marker'."
(dolist (field (yas/snippet-fields snippet)) (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-start field) (set-marker (cdr (yas/field-start field))
(setf (yas/field-end field) (set-marker (cdr (yas/field-end field)) (car (yas/field-end 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)) (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-start mirror) (set-marker (cdr (yas/mirror-start mirror))
(setf (yas/mirror-end mirror) (set-marker (cdr (yas/mirror-end mirror)) (car (yas/mirror-end 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))) (let ((snippet-exit (yas/snippet-exit snippet)))
(when snippet-exit (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) (defun yas/commit-snippet (snippet &optional no-hooks)
"Commit SNIPPET, but leave point as it is. This renders the "Commit SNIPPET, but leave point as it is. This renders the
@ -2038,8 +2206,10 @@ Move the overlay, or create it if it does not exit."
(overlay-put yas/active-field-overlay 'face 'yas/field-highlight-face) (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 'yas/snippet snippet)
(overlay-put yas/active-field-overlay 'modification-hooks '(yas/on-field-overlay-modification)) (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-in-front-hooks
(overlay-put yas/active-field-overlay 'insert-behind-hooks '(yas/on-field-overlay-modification)))) '(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) (defun yas/on-field-overlay-modification (overlay after? beg end &optional length)
"Clears the field and updates mirrors, conditionally. "Clears the field and updates mirrors, conditionally.
@ -2119,7 +2289,9 @@ Move the overlays, or create them if they do not exit."
"When non-nil, signals attempts to erronesly exit or modify the snippet. "When non-nil, signals attempts to erronesly exit or modify the snippet.
Functions in the `post-command-hook', for example 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) (defun yas/on-protection-overlay-modification (overlay after? beg end &optional length)
"Signals a snippet violation, then issues error. "Signals a snippet violation, then issues error.
@ -2155,22 +2327,39 @@ The error should be ignored in `debug-ignored-errors'"
;;; they should account for all situations... ;;; 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 "Expand snippet at current point. Text between START and END
will be deleted before inserting template." will be deleted before inserting template."
(run-hooks 'yas/before-expand-snippet-hook) (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 ;; stacked expansion: shoosh the overlay modification hooks
;; ;;
(let ((key (buffer-substring-no-properties start end)) (let ((to-delete (and start end (buffer-substring-no-properties start end)))
(start (or start (point)))
(end (or end (point)))
(inhibit-modification-hooks t) (inhibit-modification-hooks t)
(column (current-column)) (column (current-column))
snippet) snippet)
;; Delete the trigger key, this *does* get undo-recorded.
;; Delete the region to delete, this *does* get undo-recorded.
;; ;;
(when to-delete
(delete-region start end) (delete-region start end)
(setq yas/deleted-text to-delete))
;; Narrow the region down to the template, shoosh the ;; Narrow the region down to the template, shoosh the
;; `buffer-undo-list', and create the snippet, the new snippet ;; `buffer-undo-list', and create the snippet, the new snippet
@ -2186,12 +2375,14 @@ will be deleted before inserting template."
;; ;;
(setq yas/start-column (save-restriction (widen) (current-column))) (setq yas/start-column (save-restriction (widen) (current-column)))
(insert template) (insert template)
(setq yas/deleted-text key)
(setq yas/selected-text (when mark-active key))
(setq snippet (setq snippet
(if snippet-vars (if snippet-vars
(eval `(let ,(read snippet-vars) (let ((read-vars (condition-case err
(yas/snippet-create (point-min) (point-max)))) (read snippet-vars)
(error nil))))
(eval `(let ,read-vars
(yas/snippet-create (point-min) (point-max)))))
(yas/snippet-create (point-min) (point-max)))))) (yas/snippet-create (point-min) (point-max))))))
;; stacked-expansion: This checks for stacked expansion, save the ;; stacked-expansion: This checks for stacked expansion, save the
@ -2210,7 +2401,7 @@ will be deleted before inserting template."
(yas/exit-snippet snippet)) (yas/exit-snippet snippet))
;; Push two undo actions: the deletion of the inserted contents of ;; 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 ;; `yas/take-care-of-redo' on the newly inserted snippet boundaries
;; ;;
(let ((start (overlay-start (yas/snippet-control-overlay snippet))) (let ((start (overlay-start (yas/snippet-control-overlay snippet)))
@ -2280,7 +2471,8 @@ Returns the newly created snippet."
(yas/update-mirrors snippet) (yas/update-mirrors snippet)
;; Create keymap overlay for 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 ;; Move to end
(goto-char (point-max)) (goto-char (point-max))
@ -2588,7 +2780,8 @@ When multiple expressions are found, only the last one counts."
(string-to-number (match-string-no-properties 1)))) (string-to-number (match-string-no-properties 1))))
(brand-new-field (and real-match-end-0 (brand-new-field (and real-match-end-0
(not (save-match-data (not (save-match-data
(eq (string-match "$[ \t\n]*(" (match-string-no-properties 2)) 0))) (eq (string-match "$[ \t\n]*("
(match-string-no-properties 2)) 0)))
(not (and number (zerop number))) (not (and number (zerop number)))
(yas/make-field number (yas/make-field number
(yas/make-marker (match-beginning 2)) (yas/make-marker (match-beginning 2))
@ -2610,7 +2803,8 @@ When multiple expressions are found, only the last one counts."
(while (re-search-forward yas/multi-dollar-lisp-expression-regexp nil t) (while (re-search-forward yas/multi-dollar-lisp-expression-regexp nil t)
(let* ((real-match-end-1 (yas/scan-sexps (match-beginning 1) 1))) (let* ((real-match-end-1 (yas/scan-sexps (match-beginning 1) 1)))
(when real-match-end-1 (when real-match-end-1
(let ((lisp-expression-string (buffer-substring-no-properties (match-beginning 1) 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))) (setf (yas/field-transform parent-field) (yas/restore-escapes lisp-expression-string)))
(yas/add-to-list dollar-regions (yas/add-to-list dollar-regions
(cons (match-beginning 0) real-match-end-1)))))))) (cons (match-beginning 0) real-match-end-1))))))))
@ -2627,7 +2821,8 @@ When multiple expressions are found, only the last one counts."
field) field)
(push (yas/make-mirror (yas/make-marker (match-beginning 0)) (push (yas/make-mirror (yas/make-marker (match-beginning 0))
(yas/make-marker (match-beginning 0)) (yas/make-marker (match-beginning 0))
(yas/restore-escapes (buffer-substring-no-properties (match-beginning 2) (yas/restore-escapes
(buffer-substring-no-properties (match-beginning 2)
(1- real-match-end-0)))) (1- real-match-end-0))))
(yas/field-mirrors field)) (yas/field-mirrors field))
(yas/add-to-list dollar-regions (yas/add-to-list dollar-regions
@ -2693,7 +2888,8 @@ When multiple expressions are found, only the last one counts."
(let ((reflection (or (yas/apply-transform mirror field) (let ((reflection (or (yas/apply-transform mirror field)
(yas/field-text-for-display field)))) (yas/field-text-for-display field))))
(when (and reflection (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)) (goto-char (yas/mirror-start mirror))
(insert reflection) (insert reflection)
(if (> (yas/mirror-end mirror) (point)) (if (> (yas/mirror-end mirror) (point))
@ -2708,7 +2904,8 @@ When multiple expressions are found, only the last one counts."
(transformed (yas/apply-transform field field)) (transformed (yas/apply-transform field field))
(point (point))) (point (point)))
(when (and transformed (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) (setf (yas/field-modified-p field) t)
(goto-char (yas/field-start field)) (goto-char (yas/field-start field))
(insert transformed) (insert transformed)
@ -2759,7 +2956,24 @@ When multiple expressions are found, only the last one counts."
;; shit))) ;; 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'." "Debug snippets, fields, mirrors and the `buffer-undo-list'."
(interactive) (interactive)
(with-output-to-temp-buffer "*YASnippet trace*" (with-output-to-temp-buffer "*YASnippet trace*"
@ -2853,7 +3067,7 @@ When multiple expressions are found, only the last one counts."
(setq abbrev "$f") (setq abbrev "$f")
(insert abbrev)) (insert abbrev))
(unless quiet (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) (provide 'yasnippet)