procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix "C-h k" and "C-h c" with Paste from Kill Menu

Browse source 
* lisp/subr.el (event-basic-type, event-modifiers): Return nil if
EVENT is a string.  (Bug#62626)
This commit is contained in:
Eli Zaretskii 2023-04-08 15:36:44 +03:00
parent b36c21e27d
commit b63a9eda01
1 changed files with 38 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

74
lisp/subr.el
View file

@ -1520,31 +1520,32 @@ EVENT may be an event or an event type. If EVENT is a symbol
that has never been used in an event that has been read as input that has never been used in an event that has been read as input
in the current Emacs session, then this function may fail to include in the current Emacs session, then this function may fail to include
the `click' modifier." the `click' modifier."
(let ((type event)) (unless (stringp event)
(if (listp type) (let ((type event))
(setq type (car type))) (if (listp type)
(if (symbolp type) (setq type (car type)))
;; Don't read event-symbol-elements directly since we're not (if (symbolp type)
;; sure the symbol has already been parsed. ;; Don't read event-symbol-elements directly since we're not
(cdr (internal-event-symbol-parse-modifiers type)) ;; sure the symbol has already been parsed.
(let ((list nil) (cdr (internal-event-symbol-parse-modifiers type))
(char (logand type (lognot (logior ?\M-\0 ?\C-\0 ?\S-\0 (let ((list nil)
?\H-\0 ?\s-\0 ?\A-\0))))) (char (logand type (lognot (logior ?\M-\0 ?\C-\0 ?\S-\0
(if (not (zerop (logand type ?\M-\0))) ?\H-\0 ?\s-\0 ?\A-\0)))))
(push 'meta list)) (if (not (zerop (logand type ?\M-\0)))
(if (or (not (zerop (logand type ?\C-\0))) (push 'meta list))
(< char 32)) (if (or (not (zerop (logand type ?\C-\0)))
(push 'control list)) (< char 32))
(if (or (not (zerop (logand type ?\S-\0))) (push 'control list))
(/= char (downcase char))) (if (or (not (zerop (logand type ?\S-\0)))
(push 'shift list)) (/= char (downcase char)))
(or (zerop (logand type ?\H-\0)) (push 'shift list))
(push 'hyper list)) (or (zerop (logand type ?\H-\0))
(or (zerop (logand type ?\s-\0)) (push 'hyper list))
(push 'super list)) (or (zerop (logand type ?\s-\0))
(or (zerop (logand type ?\A-\0)) (push 'super list))
(push 'alt list)) (or (zerop (logand type ?\A-\0))
list)))) (push 'alt list))
list)))))
(defun event-basic-type (event) (defun event-basic-type (event)
"Return the basic type of the given event (all modifiers removed). "Return the basic type of the given event (all modifiers removed).
@ -1552,17 +1553,18 @@ The value is a printing character (not upper case) or a symbol.
EVENT may be an event or an event type. If EVENT is a symbol EVENT may be an event or an event type. If EVENT is a symbol
that has never been used in an event that has been read as input that has never been used in an event that has been read as input
in the current Emacs session, then this function may return nil." in the current Emacs session, then this function may return nil."
(if (consp event) (unless (stringp event)
(setq event (car event))) (if (consp event)
(if (symbolp event) (setq event (car event)))
(car (get event 'event-symbol-elements)) (if (symbolp event)
(let* ((base (logand event (1- ?\A-\0))) (car (get event 'event-symbol-elements))
(uncontrolled (if (< base 32) (logior base 64) base))) (let* ((base (logand event (1- ?\A-\0)))
;; There are some numbers that are invalid characters and (uncontrolled (if (< base 32) (logior base 64) base)))
;; cause `downcase' to get an error. ;; There are some numbers that are invalid characters and
(condition-case () ;; cause `downcase' to get an error.
(downcase uncontrolled) (condition-case ()
(error uncontrolled))))) (downcase uncontrolled)
(error uncontrolled))))))
(defsubst mouse-movement-p (object) (defsubst mouse-movement-p (object)
"Return non-nil if OBJECT is a mouse movement event." "Return non-nil if OBJECT is a mouse movement event."