Prevent further cases of duplicated separators in context menus

In some cases, context menu items are added before the overall prompt
string.  This could cause multiple consecutive separators to appear if
they "surround" the prompt string.  (Bug#52293)

* lisp/mouse.el (context-menu-map): Improve the de-duplication logic
to ignore non-menu-items when checking for consecutive separators.

* test/lisp/mouse-tests.el
(context-menu-map-remove-consecutive-separators)
(context-menu-map-remove-separators-at-beginning-or-end): New tests.

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 0071420efc75007d79de01b5ad995543b51b12c3..1a76b9a0b663ee88e5815004b06be6a4498c89ca 100644 (file)
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -329,21 +329,29 @@ the function `context-menu-filter-function'."
 
     ;; Remove duplicate separators as well as ones at the beginning or
     ;; end of the menu.
-    (let ((l menu) saw-first-item)
+    (let ((l menu) (last-saw-separator t))
       (while (and (consp l)
                   (consp (cdr l)))
-        ;; If the next item is a separator, remove it if 1) we haven't
-        ;; seen any other items yet, or 2) it's followed by either
-        ;; another separator or the end of the list.
-        (if (and (equal (cdr-safe (cadr l)) menu-bar-separator)
-                 (or (not saw-first-item)
-                     (null (caddr l))
-                     (equal (cdr-safe (caddr l)) menu-bar-separator)))
-            (setcdr l (cddr l))
-          ;; The "first item" is any cons cell; this excludes the
-          ;; `keymap' symbol and the menu name.
-          (when (consp (cadr l)) (setq saw-first-item t))
-          (setq l (cdr l)))))
+        (if (equal (cdr-safe (cadr l)) menu-bar-separator)
+            (progn
+              ;; The next item is a separator.  Remove it if the last
+              ;; item we saw was a separator too.
+              (if last-saw-separator
+                  (setcdr l (cddr l))
+                ;; If we didn't delete this separator, update the last
+                ;; separator we saw to this one.
+                (setq last-saw-separator l
+                      l (cdr l))))
+          ;; If the next item is a cons cell, we found a non-separator
+          ;; item.  Don't remove the next separator we see.  We
+          ;; specifically check for cons cells to avoid treating the
+          ;; overall prompt string as a menu item.
+          (when (consp (cadr l))
+            (setq last-saw-separator nil))
+          (setq l (cdr l))))
+      ;; If the last item we saw was a separator, remove it.
+      (when (consp last-saw-separator)
+        (setcdr last-saw-separator (cddr last-saw-separator))))
 
     (when (functionp context-menu-filter-function)
       (setq menu (funcall context-menu-filter-function menu click)))

diff --git a/test/lisp/mouse-tests.el b/test/lisp/mouse-tests.el
index 1cc9f64f04928938fdb0686e99a33a60c61d7e82..1be32006a10b484efa4dabbbb73cfa4aa6de0af9 100644 (file)
--- a/test/lisp/mouse-tests.el
+++ b/test/lisp/mouse-tests.el
@@ -52,5 +52,167 @@ translate `mouse-1' events into `mouse-2' events."
     (should (equal (mouse-position)
                    (cons frame (cons 0 0))))))
 
+(ert-deftest context-menu-map-remove-consecutive-separators ()
+  "Check that `context-menu-map' removes consecutive separators."
+  ;; Both separators after the overall prompt string.
+  (let ((context-menu-functions
+         '((lambda (menu _click)
+             (define-key-after menu [foo-item] '(menu-item "Foo" identity))
+             (define-key-after menu [separator-1] menu-bar-separator)
+             (define-key-after menu [separator-2] menu-bar-separator)
+             (define-key-after menu [bar-item] '(menu-item "Bar" identity))
+             menu))))
+    (should (equal `(keymap
+                     "Context Menu"
+                     (foo-item menu-item "Foo" identity)
+                     (separator-1 . ,menu-bar-separator)
+                     (bar-item menu-item "Bar" identity))
+                   (context-menu-map))))
+  ;; Both separators before the overall prompt string.
+  (let ((context-menu-functions
+         '((lambda (menu _click)
+             (define-key menu [bar-item] '(menu-item "Bar" identity))
+             (define-key menu [separator-2] menu-bar-separator)
+             (define-key menu [separator-1] menu-bar-separator)
+             (define-key menu [foo-item] '(menu-item "Foo" identity))
+             menu))))
+    (should (equal `(keymap
+                     (foo-item menu-item "Foo" identity)
+                     (separator-1 . ,menu-bar-separator)
+                     (bar-item menu-item "Bar" identity)
+                     "Context Menu")
+                   (context-menu-map))))
+  ;; First separator before and second separator after the overall
+  ;; prompt string.
+  (let ((context-menu-functions
+         '((lambda (menu _click)
+             (define-key-after menu [separator-2] menu-bar-separator)
+             (define-key-after menu [bar-item] '(menu-item "Bar" identity))
+             (define-key menu [separator-1] menu-bar-separator)
+             (define-key menu [foo-item] '(menu-item "Foo" identity))
+             menu))))
+    (should (equal `(keymap
+                     (foo-item menu-item "Foo" identity)
+                     (separator-1 . ,menu-bar-separator)
+                     "Context Menu"
+                     (bar-item menu-item "Bar" identity))
+                   (context-menu-map))))
+  ;; Three consecutive separators.
+  (let ((context-menu-functions
+         '((lambda (menu _click)
+             (define-key-after menu [foo-item] '(menu-item "Foo" identity))
+             (define-key-after menu [separator-1] menu-bar-separator)
+             (define-key-after menu [separator-2] menu-bar-separator)
+             (define-key-after menu [separator-3] menu-bar-separator)
+             (define-key-after menu [bar-item] '(menu-item "Bar" identity))
+             menu))))
+    (should (equal `(keymap
+                     "Context Menu"
+                     (foo-item menu-item "Foo" identity)
+                     (separator-1 . ,menu-bar-separator)
+                     (bar-item menu-item "Bar" identity))
+                   (context-menu-map)))))
+
+(ert-deftest context-menu-map-remove-separators-at-beginning-or-end ()
+  "Check that `context-menu-map' removes separators at the
+beginning or end of the menu."
+  ;; Menus with only separators.
+  (let ((test-functions
+         '(;; Separator before the overall prompt string.
+           (lambda (menu _click)
+             (define-key menu [separator] menu-bar-separator)
+             menu)
+           ;; Separator after the overall prompt string.
+           (lambda (menu _click)
+             (define-key-after menu [separator] menu-bar-separator)
+             menu)
+           ;; Begin and end separators before the overall prompt string.
+           (lambda (menu _click)
+             (define-key menu [end-separator] menu-bar-separator)
+             (define-key menu [begin-separator] menu-bar-separator)
+             menu)
+           ;; Begin and end separators after the overall prompt string.
+           (lambda (menu _click)
+             (define-key-after menu [begin-separator] menu-bar-separator)
+             (define-key-after menu [end-separator] menu-bar-separator)
+             menu)
+           ;; Begin separator before and end separator after the
+           ;; overall prompt string.
+           (lambda (menu _click)
+             (define-key menu [begin-separator] menu-bar-separator)
+             (define-key-after menu [end-separator] menu-bar-separator)
+             menu))))
+    (dolist (fun test-functions)
+      (let ((context-menu-functions (list fun)))
+        (should (equal '(keymap "Context Menu")
+                       (context-menu-map))))))
+  ;; Menus with separators at beginning and/or end with a menu-item
+  ;; before the prompt string.
+  (let ((test-functions
+         '(;; Separator before the overall prompt string and the menu-item.
+           (lambda (menu _click)
+             (define-key menu [foo-item] '(menu-item "Foo" identity))
+             (define-key menu [separator] menu-bar-separator)
+             menu)
+           ;; Separator before the overall prompt string, but after
+           ;; the menu-item.
+           (lambda (menu _click)
+             (define-key menu [separator] menu-bar-separator)
+             (define-key menu [foo-item] '(menu-item "Foo" identity))
+             menu)
+           ;; Separator at the end.
+           (lambda (menu _click)
+             (define-key menu [foo-item] '(menu-item "Foo" identity))
+             (define-key-after menu [separator] menu-bar-separator)
+             menu)
+           ;; Begin separator before and end separator after the
+           ;; overall prompt string.
+           (lambda (menu _click)
+             (define-key menu [foo-item] '(menu-item "Foo" identity))
+             (define-key menu [begin-separator] menu-bar-separator)
+             (define-key-after menu [end-separator] menu-bar-separator)
+             menu))))
+    (dolist (fun test-functions)
+      (let ((context-menu-functions (list fun)))
+        (should (equal '(keymap (foo-item menu-item "Foo" identity)
+                                "Context Menu")
+                       (context-menu-map))))))
+  ;; Menus with separators at beginning and/or end with a menu-item
+  ;; after the prompt string.
+  (let ((test-functions
+         '(;; Separator before the overall prompt string.
+           (lambda (menu _click)
+             (define-key menu [separator] menu-bar-separator)
+             (define-key-after menu [foo-item] '(menu-item "Foo" identity))
+             menu)
+           ;; Separator after the overall prompt string, but before
+           ;; the menu-item.
+           (lambda (menu _click)
+             (define-key-after menu [separator] menu-bar-separator)
+             (define-key-after menu [foo-item] '(menu-item "Foo" identity))
+             menu)
+           ;; Separator at the end.
+           (lambda (menu _click)
+             (define-key-after menu [foo-item] '(menu-item "Foo" identity))
+             (define-key-after menu [separator] menu-bar-separator)
+             menu)
+           ;; Begin and end separators after the overall prompt string.
+           (lambda (menu _click)
+             (define-key-after menu [begin-separator] menu-bar-separator)
+             (define-key-after menu [foo-item] '(menu-item "Foo" identity))
+             (define-key-after menu [end-separator] menu-bar-separator)
+             menu)
+           ;; Begin separator before and end separator after the
+           ;; overall prompt string.
+           (lambda (menu _click)
+             (define-key menu [begin-separator] menu-bar-separator)
+             (define-key-after menu [foo-item] '(menu-item "Foo" identity))
+             (define-key-after menu [end-separator] menu-bar-separator)
+             menu))))
+    (dolist (fun test-functions)
+      (let ((context-menu-functions (list fun)))
+        (should (equal '(keymap "Context Menu"
+                                (foo-item menu-item "Foo" identity))
+                       (context-menu-map)))))))
 
 ;;; mouse-tests.el ends here