master 3eaf3aeec8: Prevent further cases of duplicated separators in context menus

[Juri Linkov]

branch: master
commit 3eaf3aeec8a23dda8f9a170909bcc052c3d4ab78
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Juri Linkov <juri@linkov.net>

    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.
---
 lisp/mouse.el            |  34 ++++++----
 test/lisp/mouse-tests.el | 162 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 183 insertions(+), 13 deletions(-)

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 0071420efc..1a76b9a0b6 100644
--- 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 1cc9f64f04..1be32006a1 100644
--- 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