bug#52293: 29.0.50; [PATCH v4] Prevent further cases of duplicated separators in context menus

[Jim Porter <jporterbugs@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1471 bytes --]

On 1/2/2022 11:27 AM, Juri Linkov wrote:
>> I've attached an updated patch that lets context-menu-functions add items
>> to the beginning of the keymap as they currently do, while still removing
>> consecutive separators correctly. Since this logic is a bit tricky, it
>> could probably use an automated test or two, but before I write some,
>> I wanted to check that the strategy I'm using seems reasonable. It's
>> probably easiest to explain the logic by just pointing to the patch;
>> I added several comments describing the behavior so that reviewers (and
>> future readers) should be able to make sense of it.
> 
> Thanks, I suppose it's for master, not for the release branch?

Yeah, it's based on top of my previous patches that only landed on 
master, so the same applies for this one. I don't personally have an 
issue with if it merged to the release branch, but I also understand 
that we can't keep adding things to Emacs 28 forever.

Attached is an updated patch with unit tests as well as a fix to the 
behavior from the previous version; in my last patch, it didn't delete 
the last separator in the menu if it was *before* the "Context Menu" 
overall prompt string. (This could happen if all the 
context-menu-functions *only* used `define-key'.)

I've fixed that, though it did make the function a bit more complex. 
I've compensated for that with some more comments and what I hope are 
pretty thorough tests to make sure everything works as expected.

[-- Attachment #2: 0001-Prevent-further-cases-of-duplicated-separators-in-co.patch --]
[-- Type: text/plain, Size: 11505 bytes --]

From dc2b04d5f20ef861e13b0820a4377951cb528b53 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sun, 2 Jan 2022 22:08:52 -0800
Subject: [PATCH] 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.

* 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-consecutive-separators): 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 11fdd3f639..50fb1137ec 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -329,21 +329,29 @@ context-menu-map
 
     ;; 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 56411d0365..96206cd9f8 100644
--- a/test/lisp/mouse-tests.el
+++ b/test/lisp/mouse-tests.el
@@ -52,5 +52,167 @@ bug26816-mouse-frame-movement
     (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
-- 
2.25.1