[elpa] master 48cd716 14/63: Use more compact format for snippet menus

[Noam Postavsky]

branch: master
commit 48cd7163b2475bbbea166cd0d02b4bf588f1435f
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>

    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.
---
 yasnippet-tests.el | 23 +++++++++++++------
 yasnippet.el       | 66 +++++++++++++++++++++++++++---------------------------
 2 files changed, 49 insertions(+), 40 deletions(-)

diff --git a/yasnippet-tests.el b/yasnippet-tests.el
index c50aa9d..50fce61 100644
--- a/yasnippet-tests.el
+++ b/yasnippet-tests.el
@@ -843,6 +843,7 @@ TODO: correct this bug!"
 ;;; Menu
 ;;;
 (defmacro yas-with-even-more-interesting-snippet-dirs (&rest body)
+  (declare (debug t))
   `(yas-saving-variables
     (yas-with-snippet-dirs
       `((".emacs.d/snippets"
@@ -878,16 +879,16 @@ TODO: correct this bug!"
   (let ((yas-use-menu t))
     (yas-with-even-more-interesting-snippet-dirs
      (yas-reload-all 'no-jit)
-     (let ((menu (cdr (gethash 'fancy-mode yas--menu-table))))
-       (should (eql 4 (length menu)))
+     (let ((menu-items (yas--collect-menu-items
+                        (gethash 'fancy-mode yas--menu-table))))
+       (should (eql 4 (length menu-items)))
        (dolist (item '("a-guy" "a-beggar"))
-         (should (cl-find item menu :key #'cl-third :test #'string=)))
-       (should-not (cl-find "an-outcast" menu :key #'cl-third :test #'string=))
+         (should (cl-find item menu-items :key #'cl-second :test #'string=)))
+       (should-not (cl-find "an-outcast" menu-items :key #'cl-second :test 
#'string=))
        (dolist (submenu '("sirs" "ladies"))
          (should (keymapp
-                  (cl-fourth
-                   (cl-find submenu menu :key #'cl-third :test #'string=)))))
-       ))))
+                  (cl-third
+                   (cl-find submenu menu-items :key #'cl-second :test 
#'string=)))))))))
 
 (ert-deftest test-group-menus ()
   "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-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)
   (dolist (key keys)
     (yas-exit-all-snippets)
diff --git a/yasnippet.el b/yasnippet.el
index e0333bb..7b01599 100644
--- a/yasnippet.el
+++ b/yasnippet.el
@@ -2006,7 +2006,7 @@ static in the menu."
   ;; higher passes.
   ;;
   (mapc #'(lambda (item)
-            (when (and (listp (cdr item))
+            (when (and (consp (cdr-safe item))
                        (keymapp (nth 2 (cdr item))))
               (yas--delete-from-keymap (nth 2 (cdr item)) uuid)))
         (cdr keymap))
@@ -2016,9 +2016,10 @@ static in the menu."
   ;; Destructively modify keymap
   ;;
   (setcdr keymap (cl-delete-if (lambda (item)
-                                 (or (null (cdr item))
-                                     (and (keymapp (nth 2 (cdr item)))
-                                          (null (cdr (nth 2 (cdr item)))))))
+                                 (cond ((not (listp item)) nil)
+                                       ((null (cdr item)))
+                                       ((and (keymapp (nth 2 (cdr item)))
+                                             (null (cdr (nth 2 (cdr 
item))))))))
                                (cdr keymap))))
 
 (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'."
   (cl-loop
    for (type name submenu) in (reverse menu)
-   if (or (eq type 'yas-item)
-          (and yas-alias-to-yas/prefix-p
-               (eq type 'yas/item)))
-   do (let ((template (or (gethash name uuidhash)
-                          (puthash name
-                                   (yas--make-template
-                                    :table table
-                                    :perm-group group-list
-                                    :uuid name)
-                                   uuidhash))))
-        (define-key menu-keymap (vector (cl-gensym))
-          (car (yas--template-menu-binding-pair-get-create template :stay))))
-   else if (or (eq type 'yas-submenu)
-               (and yas-alias-to-yas/prefix-p
-                    (eq type 'yas/submenu)))
-   do (let ((subkeymap (make-sparse-keymap)))
-        (define-key menu-keymap (vector (cl-gensym))
-          `(menu-item ,name ,subkeymap))
-        (yas--define-menu-1 table
-                            subkeymap
-                            submenu
-                            uuidhash
-                            (append group-list (list name))))
-   else if (or (eq type 'yas-separator)
-               (and yas-alias-to-yas/prefix-p
-                    (eq type 'yas/separator)))
-   do (define-key menu-keymap (vector (cl-gensym))
-        '(menu-item "----"))
-   else do (yas--message 1 "Don't know anything about menu entry %s" type)))
+   collect (cond
+            ((or (eq type 'yas-item)
+                 (and yas-alias-to-yas/prefix-p
+                      (eq type 'yas/item)))
+             (let ((template (or (gethash name uuidhash)
+                                 (puthash name
+                                          (yas--make-template
+                                           :table table
+                                           :perm-group group-list
+                                           :uuid name)
+                                          uuidhash))))
+               (car (yas--template-menu-binding-pair-get-create
+                     template :stay))))
+            ((or (eq type 'yas-submenu)
+                 (and yas-alias-to-yas/prefix-p
+                      (eq type 'yas/submenu)))
+             (let ((subkeymap (make-sparse-keymap)))
+               (yas--define-menu-1 table subkeymap submenu uuidhash
+                                   (append group-list (list name)))
+               `(menu-item ,name ,subkeymap)))
+            ((or (eq type 'yas-separator)
+                 (and yas-alias-to-yas/prefix-p
+                      (eq type 'yas/separator)))
+             '(menu-item "----"))
+            (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)
   "Define a snippet.  Expanding KEY into TEMPLATE.