master 0dc75daf11: Filter out NS non-key events from `where-is-internal'

[Lars Ingebrigtsen]

branch: master
commit 0dc75daf1189d2327c6efa4d747fa98fcba03ea3
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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.
---
 doc/lispref/keymaps.texi |  5 +++++
 etc/NEWS                 |  6 ++++++
 lisp/keymap.el           |  5 +++++
 lisp/term/common-win.el  | 27 +++++++++++++--------------
 src/keymap.c             | 14 ++++++++++++--
 test/src/keymap-tests.el | 10 ++++++++++
 6 files changed, 51 insertions(+), 16 deletions(-)

diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index a037c228f1..a27b0ea366 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 a9c8957dfb..438cec9257 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2363,6 +2363,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
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 3a22610499..ad7d4fbbba 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 6f1e322aba..f7faba9cb7 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 c8b01eed6f..2b77a7fc44 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 69aa723849..eeac1dbe6d 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