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

* 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

View File

@ -118,7 +118,7 @@
;; your .emacs file, for example:
;;
;; (require 'dropdown-list)
;; (setq 'yas/prompt-functions '(yas/dropdown-prompt
;; (setq yas/prompt-functions '(yas/dropdown-prompt
;; yas/ido-prompt
;; yas/completing-prompt))
;;
@ -132,6 +132,7 @@
;;; Code:
(require 'cl)
(require 'assoc)
(require 'easymenu)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -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)
@ -411,14 +420,16 @@ 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)
@ -463,12 +474,12 @@ Here's an example:
(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."
@ -478,13 +489,19 @@ Here's an example:
(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 "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 "About" 'yas/about)
(list "Reload-all-snippets" 'yas/reload-all)
(list "Load snippets..." 'yas/load-directory))))))
(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/init-minor-keymap))))
(defun yas/minor-mode-on ()
"Turn on YASnippet minor mode."
@ -546,17 +563,36 @@ Key bindings:
("}"
(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)))
@ -565,16 +601,17 @@ Key bindings:
;;
(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."
"A table to store snippets for a particular mode."
name
(hash (make-hash-table :test 'equal))
(parents nil))
@ -642,6 +679,19 @@ This function implements the rules described in
(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))
@ -792,7 +842,8 @@ Here's a list of currently recognized variables:
bound
condition
group
env)
env
binding)
(if (re-search-forward "^# --\n" nil t)
(progn (setq template
(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))))
(when (string= "group" (match-string-no-properties 1))
(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)))
(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
(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?)
"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
(cons (region-beginning) (region-end))
(cons (point) (point)))))
(yas/expand-snippet (car where)
(cdr where)
(yas/template-content template))))
(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."
@ -975,32 +1028,52 @@ 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)
@ -1008,10 +1081,10 @@ content of the file is the template."
(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))
@ -1144,12 +1217,14 @@ Here's the default value for all the parameters:
") -- pluskid <pluskid@gmail.com>/joaotavora <joaotavora@gmail.com>")))
(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
@ -1165,6 +1240,8 @@ its parent modes."
(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)
@ -1176,35 +1253,81 @@ its parent modes."
parent-mode)
'((parent-mode . "parent mode")))))
(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)
(yas/menu-keymap-get-create (car sym-and-name)))))
(reverse parent-menu-syms-and-names)))))
(when (and yas/use-menu
(yas/real-mode? mode))
(when yas/use-menu
(define-key yas/minor-mode-menu (vector mode)
`(menu-item ,(symbol-name mode) ,keymap
: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
;; 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
@ -1227,11 +1350,15 @@ its parent modes."
(defun yas/show-menu-p (mode)
(message "what")
(or (not (eq yas/use-menu 'abbreviate))
(cond ((eq yas/use-menu 'abbreviate)
(find mode (cons major-mode
(if (listp 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)
"Recursively delete items name NAME from KEYMAP and its submenus.
@ -1250,7 +1377,8 @@ Skip any submenus named \"parent mode\""
;;
(when (keymapp 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)
(or
;; the menu item we want to delete
@ -1260,7 +1388,8 @@ Skip any submenus named \"parent mode\""
;; a stale subgroup
(and (keymapp (fourth item))
(not (and (stringp (third item))
(string-match "parent mode" (third item))))
(string-match "parent mode"
(third item))))
(null (rest (fourth item)))))))
keymap))
(setf (nthcdr pos-in-keymap keymap)
@ -1320,9 +1449,9 @@ defined in `yas/fallback-behavior'"
(yas/prompt-for-template (mapcar #'cdr templates)))
(cdar templates))))
(when template
(yas/expand-snippet start
(yas/expand-snippet (yas/template-content template)
start
end
(yas/template-content template)
(yas/template-env template))))
(cond ((eq yas/fallback-behavior 'return-nil)
;; return nil
@ -1382,9 +1511,9 @@ by condition."
(cons (region-beginning) (region-end))
(cons (point) (point)))))
(if template
(yas/expand-snippet (car where)
(yas/expand-snippet (yas/template-content template)
(car where)
(cdr where)
(yas/template-content template)
(yas/template-env template))
(message "[yas] No snippets can be inserted here!"))))
@ -1427,14 +1556,15 @@ also the current active tables."
;; 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))))
(dolist (table (reverse active-tables))
(setq other-path-alternative
(concat other-path-alternative "/" (yas/snippet-table-name table))))
(push other-path-alternative options))
(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)
@ -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
`yas/guess-directory'."
(interactive "P")
(let* ((guessed-directories (yas/guess-snippet-directory))
(target-directory (first (remove-if-not #'file-exists-p guessed-directories)))
(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))
(unless target-directory
(when (y-or-n-p (format "Guessed directory (%s) does not exist! Create? " (first guessed-directories)))
(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)))
(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))
@ -1502,7 +1641,8 @@ otherwise, proposes to create the first option returned by
(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: "))))
(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"))
@ -1510,7 +1650,7 @@ otherwise, proposes to create the first option returned by
(mapcar #'intern
(split-string
(with-temp-buffer
(insert-file extra-parents-file-name)
(insert-file-contents extra-parents-file-name)
(buffer-substring-no-properties (point-min)
(point-max))))))))
(when major-mode-sym
@ -1537,7 +1677,9 @@ With optional prefix argument KILL quit the window and buffer."
(save-buffer))
(if 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 "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))
(yas/parse-template (symbol-name (car major-mode-and-parent)))))
(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
(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))
(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
@ -1621,9 +1771,13 @@ Otherwise throw exception."
(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))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1834,6 +1988,15 @@ Also create some protection overlays"
(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:
;;;
;;; 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
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
@ -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 '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.
@ -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.
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.
@ -2155,22 +2327,39 @@ 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))
(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.
;;
(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
@ -2186,12 +2375,14 @@ will be deleted before inserting template."
;;
(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))))
(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
@ -2210,7 +2401,7 @@ will be deleted before inserting template."
(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)))
@ -2280,7 +2471,8 @@ Returns the newly created snippet."
(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))
@ -2588,7 +2780,8 @@ When multiple expressions are found, only the last one counts."
(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)))
(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))
@ -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)
(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)))
(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))))))))
@ -2627,7 +2821,8 @@ When multiple expressions are found, only the last one counts."
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)
(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
@ -2693,7 +2888,8 @@ When multiple expressions are found, only the last one counts."
(let ((reflection (or (yas/apply-transform mirror 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))
@ -2708,7 +2904,8 @@ When multiple expressions are found, only the last one counts."
(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)
@ -2759,7 +2956,24 @@ When multiple expressions are found, only the last one counts."
;; 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*"
@ -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)