* Full support for multiple parent-modes, including in menu

* TODO: write `yas/new-snippet'
* TODO: update documentation thoroughly
This commit is contained in:
capitaomorte 2009-07-30 18:29:35 +00:00
parent d42e5a3189
commit 2ada74c6f2

View File

@ -239,10 +239,14 @@ field"
The fall back behavior of YASnippet when it can't find a snippet The fall back behavior of YASnippet when it can't find a snippet
to expand. to expand.
`call-other-command' means try to temporarily disable `call-other-command' means try to temporarily disable YASnippet
YASnippet and call other command bound to `yas/trigger-key'. and call the next command bound to `yas/trigger-key'.
`return-nil' means return do nothing." `return-nil' means return do nothing.
An entry (apply COMMAND . ARGS) means interactively call COMMAND,
if ARGS is non-nil, call COMMAND non-interactively with ARGS as
arguments."
:type '(choice (const :tag "Call previous command" 'call-other-command) :type '(choice (const :tag "Call previous command" 'call-other-command)
(const :tag "Do nothing" 'return-nil)) (const :tag "Do nothing" 'return-nil))
:group 'yasnippet) :group 'yasnippet)
@ -715,12 +719,8 @@ MODE-SYMBOL or `major-mode'."
(defun yas/menu-keymap-get-create (mode) (defun yas/menu-keymap-get-create (mode)
"Get the menu keymap correspondong to MODE." "Get the menu keymap correspondong to MODE."
(let ((keymap (gethash mode yas/menu-table))) (or (gethash mode yas/menu-table)
(unless keymap (puthash mode (make-sparse-keymap) yas/menu-table)))
(setq keymap (make-sparse-keymap))
(puthash mode
keymap yas/menu-table))
keymap))
(defun yas/current-key () (defun yas/current-key ()
"Get the key under current position. A key is used to find "Get the key under current position. A key is used to find
@ -936,30 +936,24 @@ TEMPLATES is a list of `yas/template'."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Loading snippets from files ;; Loading snippets from files
;; ;;
(defun yas/load-directory-1 (directory &optional parents) (defun yas/load-directory-1 (directory &optional parents root)
"Recursively load snippet templates from DIRECTORY." "Recursively load snippet templates from DIRECTORY."
(let ((mode-sym (intern (file-name-nondirectory directory))) (let* ((major-mode-and-parents (yas/compute-major-mode-and-parents (concat directory "/dummy")
(snippet-defs nil) nil
(parent-file-name (concat directory "/.yas-parents")) root))
more-parents) (mode-sym (car major-mode-and-parents))
(parents (rest major-mode-and-parents))
(snippet-defs nil))
(with-temp-buffer (with-temp-buffer
(dolist (file (yas/subdirs directory 'no-subdirs-just-files)) (dolist (file (yas/subdirs directory 'no-subdirs-just-files))
(when (file-readable-p file) (when (file-readable-p file)
(insert-file-contents file nil nil nil t) (insert-file-contents file nil nil nil t)
(push (yas/parse-template file) (push (yas/parse-template file)
snippet-defs)))) snippet-defs))))
(when (file-readable-p parent-file-name)
(setq more-parents
(mapcar #'intern
(split-string
(with-temp-buffer
(insert-file parent-file-name)
(buffer-substring-no-properties (point-min)
(point-max)))))))
(yas/define-snippets mode-sym (yas/define-snippets mode-sym
snippet-defs snippet-defs
(append parents more-parents)) parents)
(dolist (subdir (yas/subdirs directory)) (dolist (subdir (yas/subdirs directory))
(yas/load-directory-1 subdir (list mode-sym))))) (yas/load-directory-1 subdir (list mode-sym)))))
@ -975,7 +969,7 @@ content of the file is the template."
(error "Error %s not a directory" directory)) (error "Error %s not a directory" directory))
(add-to-list 'yas/root-directory directory) (add-to-list 'yas/root-directory directory)
(dolist (dir (yas/subdirs directory)) (dolist (dir (yas/subdirs directory))
(yas/load-directory-1 dir)) (yas/load-directory-1 dir nil directory))
(when (interactive-p) (when (interactive-p)
(message "done."))) (message "done.")))
@ -1167,9 +1161,17 @@ its parent modes."
(setf (yas/snippet-table-parents snippet-table) (setf (yas/snippet-table-parents snippet-table)
parent-tables) parent-tables)
(when yas/use-menu (when yas/use-menu
(define-key keymap (vector 'parent-mode) (let ((parent-menu-syms-and-names
`(menu-item "parent mode" (if (listp parent-mode)
,(yas/menu-keymap-get-create 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 (when (and yas/use-menu
(yas/real-mode? mode)) (yas/real-mode? mode))
(define-key yas/minor-mode-menu (vector mode) (define-key yas/minor-mode-menu (vector mode)
@ -1225,8 +1227,7 @@ Skip any submenus named \"parent mode\""
(mapc #'(lambda (item) (mapc #'(lambda (item)
(when (and (keymapp (fourth item)) (when (and (keymapp (fourth item))
(stringp (third item)) (stringp (third item))
(not (string= (third item) (not (string-match "parent mode" (third item))))
"parent mode")))
(yas/delete-from-keymap (fourth item) name))) (yas/delete-from-keymap (fourth item) name)))
(rest keymap)) (rest keymap))
;; ;;
@ -1241,6 +1242,8 @@ Skip any submenus named \"parent mode\""
(and (string= (third item) name))) (and (string= (third item) name)))
;; a stale subgroup ;; a stale subgroup
(and (keymapp (fourth item)) (and (keymapp (fourth item))
(not (and (stringp (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)
@ -1295,13 +1298,27 @@ conditions to filter out potential expansions."
end end
(yas/template-content template) (yas/template-content template)
(yas/template-env template)))) (yas/template-env template))))
(if (eq yas/fallback-behavior 'return-nil) (cond ((eq yas/fallback-behavior 'return-nil)
nil ; return nil ;; return nil
nil)
((eq yas/fallback-behavior 'call-other-command)
(let* ((yas/minor-mode nil) (let* ((yas/minor-mode nil)
(command (key-binding (read-kbd-macro yas/trigger-key)))) (command (key-binding (read-kbd-macro yas/trigger-key))))
(when (commandp command) (when (commandp command)
(setq this-command command) (setq this-command command)
(call-interactively 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) (defun yas/all-templates (tables)
"Return all snippet tables applicable for the current buffer. "Return all snippet tables applicable for the current buffer.
@ -1435,7 +1452,7 @@ otherwise, proposes to create the first option returned by
(when (eq major-mode 'fundamental-mode) (when (eq major-mode 'fundamental-mode)
(snippet-mode)))))))) (snippet-mode))))))))
(defun yas/compute-major-mode-and-parent (file &optional prompt-if-failed) (defun yas/compute-major-mode-and-parents (file &optional prompt-if-failed root-directory)
(let* ((file-dir (and file (let* ((file-dir (and file
(directory-file-name (file-name-directory file)))) (directory-file-name (file-name-directory file))))
(major-mode-name (and file-dir (major-mode-name (and file-dir
@ -1443,17 +1460,25 @@ otherwise, proposes to create the first option returned by
(parent-file-dir (and file-dir (parent-file-dir (and file-dir
(directory-file-name (file-name-directory file-dir)))) (directory-file-name (file-name-directory file-dir))))
(parent-mode-name (and parent-file-dir (parent-mode-name (and parent-file-dir
(not (string= parent-file-dir root-directory))
(file-name-nondirectory parent-file-dir))) (file-name-nondirectory parent-file-dir)))
(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)))
(if (fboundp major-mode-sym) (parent-file-name (concat file-dir "/.yas-parents"))
(cons major-mode-sym (more-parents (when (file-readable-p parent-file-name)
(when (fboundp parent-mode-sym) (mapcar #'intern
parent-mode-sym))))) (split-string
(with-temp-buffer
(insert-file parent-file-name)
(buffer-substring-no-properties (point-min)
(point-max))))))))
(when major-mode-sym
(append (list major-mode-sym parent-mode-sym)
more-parents))))
(defun yas/load-snippet-buffer (&optional kill) (defun yas/load-snippet-buffer (&optional kill)
"Parse and load current buffer's snippet definition. "Parse and load current buffer's snippet definition.