Use more compact format for snippet menus

* yasnippet-tests.el (yas-with-even-more-interesting-snippet-dirs): Add
debug declaration.
(yas--collect-menu-items): New function.
(test-yas-define-menu): Use it to become keymap format agnostic.
* yasnippet.el (yas--delete-from-keymap): This function deletes entries
created by `yas--update-template-menu', which are always list elements.
Skip other types of keymap elements.
(yas--define-menu-1): Create a keymap with a vector element instead of a
list with gensym symbol binding list.
This commit is contained in:
Noam Postavsky 2016-12-11 16:43:44 -05:00
parent 7b3c29d210
commit 48cd7163b2
2 changed files with 49 additions and 40 deletions

View File

@ -843,6 +843,7 @@ TODO: correct this bug!"
;;; Menu ;;; Menu
;;; ;;;
(defmacro yas-with-even-more-interesting-snippet-dirs (&rest body) (defmacro yas-with-even-more-interesting-snippet-dirs (&rest body)
(declare (debug t))
`(yas-saving-variables `(yas-saving-variables
(yas-with-snippet-dirs (yas-with-snippet-dirs
`((".emacs.d/snippets" `((".emacs.d/snippets"
@ -878,16 +879,16 @@ TODO: correct this bug!"
(let ((yas-use-menu t)) (let ((yas-use-menu t))
(yas-with-even-more-interesting-snippet-dirs (yas-with-even-more-interesting-snippet-dirs
(yas-reload-all 'no-jit) (yas-reload-all 'no-jit)
(let ((menu (cdr (gethash 'fancy-mode yas--menu-table)))) (let ((menu-items (yas--collect-menu-items
(should (eql 4 (length menu))) (gethash 'fancy-mode yas--menu-table))))
(should (eql 4 (length menu-items)))
(dolist (item '("a-guy" "a-beggar")) (dolist (item '("a-guy" "a-beggar"))
(should (cl-find item menu :key #'cl-third :test #'string=))) (should (cl-find item menu-items :key #'cl-second :test #'string=)))
(should-not (cl-find "an-outcast" menu :key #'cl-third :test #'string=)) (should-not (cl-find "an-outcast" menu-items :key #'cl-second :test #'string=))
(dolist (submenu '("sirs" "ladies")) (dolist (submenu '("sirs" "ladies"))
(should (keymapp (should (keymapp
(cl-fourth (cl-third
(cl-find submenu menu :key #'cl-third :test #'string=))))) (cl-find submenu menu-items :key #'cl-second :test #'string=)))))))))
))))
(ert-deftest test-group-menus () (ert-deftest test-group-menus ()
"Test group-based menus using .yas-make-groups and the group directive" "Test group-based menus using .yas-make-groups and the group directive"
@ -1037,6 +1038,14 @@ add the snippets associated with the given mode."
(yas--buffer-contents))))) (yas--buffer-contents)))))
(yas-exit-all-snippets)) (yas-exit-all-snippets))
(defun yas--collect-menu-items (menu-keymap)
(let ((yas--menu-items ()))
(map-keymap (lambda (_binding definition)
(when (eq (car-safe definition) 'menu-item)
(push definition yas--menu-items)))
menu-keymap)
yas--menu-items))
(defun yas-should-not-expand (keys) (defun yas-should-not-expand (keys)
(dolist (key keys) (dolist (key keys)
(yas-exit-all-snippets) (yas-exit-all-snippets)

View File

@ -2006,7 +2006,7 @@ static in the menu."
;; higher passes. ;; higher passes.
;; ;;
(mapc #'(lambda (item) (mapc #'(lambda (item)
(when (and (listp (cdr item)) (when (and (consp (cdr-safe item))
(keymapp (nth 2 (cdr item)))) (keymapp (nth 2 (cdr item))))
(yas--delete-from-keymap (nth 2 (cdr item)) uuid))) (yas--delete-from-keymap (nth 2 (cdr item)) uuid)))
(cdr keymap)) (cdr keymap))
@ -2016,9 +2016,10 @@ static in the menu."
;; Destructively modify keymap ;; Destructively modify keymap
;; ;;
(setcdr keymap (cl-delete-if (lambda (item) (setcdr keymap (cl-delete-if (lambda (item)
(or (null (cdr item)) (cond ((not (listp item)) nil)
(and (keymapp (nth 2 (cdr item))) ((null (cdr item)))
(null (cdr (nth 2 (cdr item))))))) ((and (keymapp (nth 2 (cdr item)))
(null (cdr (nth 2 (cdr item))))))))
(cdr keymap)))) (cdr keymap))))
(defun yas-define-menu (mode menu &optional omit-items) (defun yas-define-menu (mode menu &optional omit-items)
@ -2056,35 +2057,34 @@ omitted from MODE's menu, even if they're manually loaded."
"Helper for `yas-define-menu'." "Helper for `yas-define-menu'."
(cl-loop (cl-loop
for (type name submenu) in (reverse menu) for (type name submenu) in (reverse menu)
if (or (eq type 'yas-item) collect (cond
((or (eq type 'yas-item)
(and yas-alias-to-yas/prefix-p (and yas-alias-to-yas/prefix-p
(eq type 'yas/item))) (eq type 'yas/item)))
do (let ((template (or (gethash name uuidhash) (let ((template (or (gethash name uuidhash)
(puthash name (puthash name
(yas--make-template (yas--make-template
:table table :table table
:perm-group group-list :perm-group group-list
:uuid name) :uuid name)
uuidhash)))) uuidhash))))
(define-key menu-keymap (vector (cl-gensym)) (car (yas--template-menu-binding-pair-get-create
(car (yas--template-menu-binding-pair-get-create template :stay)))) template :stay))))
else if (or (eq type 'yas-submenu) ((or (eq type 'yas-submenu)
(and yas-alias-to-yas/prefix-p (and yas-alias-to-yas/prefix-p
(eq type 'yas/submenu))) (eq type 'yas/submenu)))
do (let ((subkeymap (make-sparse-keymap))) (let ((subkeymap (make-sparse-keymap)))
(define-key menu-keymap (vector (cl-gensym)) (yas--define-menu-1 table subkeymap submenu uuidhash
`(menu-item ,name ,subkeymap)) (append group-list (list name)))
(yas--define-menu-1 table `(menu-item ,name ,subkeymap)))
subkeymap ((or (eq type 'yas-separator)
submenu
uuidhash
(append group-list (list name))))
else if (or (eq type 'yas-separator)
(and yas-alias-to-yas/prefix-p (and yas-alias-to-yas/prefix-p
(eq type 'yas/separator))) (eq type 'yas/separator)))
do (define-key menu-keymap (vector (cl-gensym))
'(menu-item "----")) '(menu-item "----"))
else do (yas--message 1 "Don't know anything about menu entry %s" type))) (t (yas--message 1 "Don't know anything about menu entry %s" type)
nil))
into menu-entries
finally do (push (apply #'vector menu-entries) (cdr menu-keymap))))
(defun yas--define (mode key template &optional name condition group) (defun yas--define (mode key template &optional name condition group)
"Define a snippet. Expanding KEY into TEMPLATE. "Define a snippet. Expanding KEY into TEMPLATE.