Filter out NS non-key events from `where-is-internal'

* doc/lispref/keymaps.texi (Scanning Keymaps): Document it.
* lisp/keymap.el (make-non-key-event): New function.

* lisp/term/common-win.el (x-setup-function-keys): Mark ns events
as not being keys (bug#55940).

* src/keymap.c (Fwhere_is_internal): Filter out key sequences that
are marked as being non-keys.

6 files changed, 51 insertions, 16 deletions

diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index a037c228f13..a27b0ea366c 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -2209,6 +2209,11 @@ If @var{no-remap} is @code{nil}, return the bindings for
 non-@code{nil}, return the bindings for @var{command}, ignoring the
 fact that it is remapped.
 @end table
+
+If a command maps to a key binding like @code{[some-event]}, and
+@code{some-event} has a symbol plist containing a non-@code{nil}
+@code{non-key-event} property, then that binding is ignored by
+@code{where-is-internal}.
 @end defun
 
 @deffn Command describe-bindings &optional prefix buffer-or-name
diff --git a/etc/NEWS b/etc/NEWS
index a9c8957dfbb..438cec9257f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2364,6 +2364,12 @@ option.
 ** Keymaps and key definitions
 
 +++
+*** 'where-is-internal' can now filter events marked as non key events.
+If a command maps to a key binding like [some-event], and 'some-event'
+has a symbol plist containing a non-nil 'non-key-event' property, then
+that binding is ignored by 'where-is-internal'.
+
++++
 *** New functions for defining and manipulating keystrokes.
 These all take the syntax defined by 'key-valid-p'.  None of the older
 functions have been deprecated or altered, but they are now
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 3a22610499c..ad7d4fbbba1 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -575,6 +575,11 @@ as the variable documentation string.
        (define-keymap ,@(nreverse opts) ,@defs)
        ,@(and doc (list doc)))))
 
+(defun make-non-key-event (symbol)
+  "Mark SYMBOL as an event that shouldn't be returned from `where-is'."
+  (put symbol 'non-key-event t)
+  symbol)
+
 (provide 'keymap)
 
 ;;; keymap.el ends here
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index 6f1e322aba5..f7faba9cb7c 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -59,20 +59,19 @@
 	(setq system-key-alist
 	      (list
 	       ;; These are special "keys" used to pass events from C to lisp.
-	       (cons  1 'ns-power-off)
-	       (cons  2 'ns-open-file)
-	       (cons  3 'ns-open-temp-file)
-	       (cons  4 'ns-drag-file)
-	       (cons  5 'ns-drag-color)
-	       (cons  6 'ns-drag-text)
-	       (cons  8 'ns-open-file-line)
-;;;	       (cons  9 'ns-insert-working-text)
-;;;	       (cons 10 'ns-delete-working-text)
-	       (cons 11 'ns-spi-service-call)
-	       (cons 12 'ns-new-frame)
-	       (cons 13 'ns-toggle-toolbar)
-	       (cons 14 'ns-show-prefs)
-	       ))))
+	       (cons  1 (make-non-key-event 'ns-power-off))
+	       (cons  2 (make-non-key-event 'ns-open-file))
+	       (cons  3 (make-non-key-event 'ns-open-temp-file))
+	       (cons  4 (make-non-key-event 'ns-drag-file))
+	       (cons  5 (make-non-key-event 'ns-drag-color))
+	       (cons  6 (make-non-key-event 'ns-drag-text))
+	       (cons  8 (make-non-key-event 'ns-open-file-line))
+;;;	       (cons  9 (make-non-key-event 'ns-insert-working-text))
+;;;	       (cons 10 (make-non-key-event 'ns-delete-working-text))
+	       (cons 11 (make-non-key-event 'ns-spi-service-call))
+	       (cons 12 (make-non-key-event 'ns-new-frame))
+	       (cons 13 (make-non-key-event 'ns-toggle-toolbar))
+	       (cons 14 (make-non-key-event 'ns-show-prefs))))))
     (set-terminal-parameter frame 'x-setup-function-keys t)))
 
 (defvar x-invocation-args)
diff --git a/src/keymap.c b/src/keymap.c
index c8b01eed6fd..2b77a7fc444 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -2596,7 +2596,10 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
 
 - If DEFINITION is remapped to OTHER-COMMAND, normally return the
   bindings for OTHER-COMMAND.  But if NO-REMAP is non-nil, return the
-  bindings for DEFINITION instead, ignoring its remapping.  */)
+  bindings for DEFINITION instead, ignoring its remapping.
+
+Keys that are represented as events that have a `non-key-event' non-nil
+symbol property are ignored.  */)
   (Lisp_Object definition, Lisp_Object keymap, Lisp_Object firstonly, Lisp_Object noindirect, Lisp_Object no_remap)
 {
   /* The keymaps in which to search.  */
@@ -2720,7 +2723,12 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
 
       /* It is a true unshadowed match.  Record it, unless it's already
 	 been seen (as could happen when inheriting keymaps).  */
-      if (NILP (Fmember (sequence, found)))
+      if (NILP (Fmember (sequence, found))
+	  /* Filter out non key events.  */
+	  && !(VECTORP (sequence)
+	       && ASIZE (sequence) == 1
+	       && SYMBOLP (AREF (sequence, 0))
+	       && !NILP (Fget (AREF (sequence, 0), Qnon_key_event))))
 	found = Fcons (sequence, found);
 
       /* If firstonly is Qnon_ascii, then we can return the first
@@ -3461,4 +3469,6 @@ that describe key bindings.  That is why the default is nil.  */);
 
   DEFSYM (Qkey_parse, "key-parse");
   DEFSYM (Qkey_valid_p, "key-valid-p");
+
+  DEFSYM (Qnon_key_event, "non-key-event");
 }
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index 69aa7238493..eeac1dbe6d1 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -418,6 +418,16 @@ g .. h		foo
   (should-error (text-char-description ?\M-c))
   (should-error (text-char-description ?\s-c)))
 
+(ert-deftest test-non-key-events ()
+  (should (null (where-is-internal 'keymap-tests-command)))
+  (keymap-set global-map "C-c g" #'keymap-tests-command)
+  (should (equal (where-is-internal 'keymap-tests-command) '([3 103])))
+  (keymap-set global-map "<keymap-tests-event>" #'keymap-tests-command)
+  (should (equal (where-is-internal 'keymap-tests-command)
+                 '([keymap-tests-event] [3 103])))
+  (make-non-key-event 'keymap-tests-event)
+  (should (equal (where-is-internal 'keymap-tests-command) '([3 103]))))
+
 (provide 'keymap-tests)
 
 ;;; keymap-tests.el ends here