From 1a1c5a6884a60ef2ffa98f3ee4af793eac985f80 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 8 Apr 2022 09:47:25 +0800 Subject: [PATCH] Add code for determining the type of an input device * doc/lispref/commands.texi (Command Loop Info): * etc/NEWS: Update documentation and announce `device-class'. * lisp/frame.el (x-device-class): (device-class): * lisp/term/x-win.el (x-device-class): New functions. --- doc/lispref/commands.texi | 76 +++++++++++++++++++++++++++++++++++++++ etc/NEWS | 7 ++-- lisp/frame.el | 61 +++++++++++++++++++++++++++++++ lisp/term/x-win.el | 32 +++++++++++++++++ 4 files changed, 173 insertions(+), 3 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 74bf0f48692..ace0c025512 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1127,6 +1127,23 @@ frame, the value is the frame to which the event was redirected. If the last event came from a keyboard macro, the value is @code{macro}. @end defvar +@cindex input devices +@cindex device names +Input events must come from somewhere; sometimes, that is a keyboard +macro, a signal, or `unread-command-events', but it is usually a +physical input device connected to a computer that is controlled by +the user. Those devices are referred to as @dfn{input devices}, and +Emacs associates each input event with the input device from which it +originated. They are identified by a name that is unique to each +input device. + +The ability to determine the precise input device used depends on the +details of each system. When that information is unavailable, Emacs +reports keyboard events as originating from the @samp{"Virtual core +keyboard"}, and other events as originating from the @samp{"Virtual +core pointer"}. (These values are used on every platform because the +X server reports them when detailed device information is not known.) + @defvar last-event-device This variable records the name of the input device from which the last input event read was generated. It is @code{nil} if no such device @@ -1141,6 +1158,65 @@ keyboard"}, depending on whether the event was generated by a pointing device (such as a mouse) or a keyboard. @end defvar +@defun device-class frame name +There are various different types of devices, which can be determined +from their names. This function can be used to determined the correct +type of the device @var{name} for an event originating from +@var{frame}. + +The return value is one of the following symbols (``device classes''): + +@table @code +@item core-keyboard +The core keyboard; this is means the device is a keyboard-like device, +but no other characteristics are unknown. + +@item core-pointer +The core pointer; this means the device is a pointing device, but no +other characteristics are known. + +@item mouse +A computer mouse. + +@item trackpoint +A trackpoint or joystick (or other similar control.) + +@item eraser +The other end of a stylus on a graphics tablet, or a standalone +eraser. + +@item pen +The pointed end of a pen on a graphics tablet, a stylus, or some other +similar device. + +@item puck +A device that looks like a computer mouse, but reports absolute +coordinates relative to some other surface. + +@item power-button +A power button or volume button (or other similar control.) + +@item keyboard +A computer keyboard. + +@item touchscreen +A computer touchpad. + +@item pad +A collection of sensitive buttons, rings, and strips commonly found +around a drawing tablet. + +@item touchpad +An indirect touch device such as a touchpad. + +@item piano +A musical instrument such as an electronic keyboard. + +@item test +A device used by the XTEST extension to report input. +@end table +@end defun + @node Adjusting Point @section Adjusting Point After Commands @cindex adjusting point diff --git a/etc/NEWS b/etc/NEWS index 1043873f2d7..2fac893cc52 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1360,9 +1360,10 @@ functions. * Lisp Changes in Emacs 29.1 +++ -** New variable 'last-event-device'. -On X Windows, this specifies the input extension device from which the -last input event originated. +** New variable 'last-event-device' and new function 'device-class'. +On X Windows, 'last-event-device' specifies the input extension device +from which the last input event originated, and 'device-class' can be +used to determine the type of an input device. +++ ** 'track-mouse' can be a new value 'drag-source'. diff --git a/lisp/frame.el b/lisp/frame.el index b681a971aa3..395fe8daad8 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2433,6 +2433,67 @@ monitors." ,(display-mm-height display))) (frames . ,(frames-on-display-list display))))))))) +(declare-function x-device-class (name) "x-win.el") + +(defun device-class (frame name) + "Return the class of the device NAME for an event generated on FRAME. +NAME is a string that can be the value of `last-event-device', or +nil. FRAME is a window system frame, typically the value of +`last-event-frame' when `last-event-device' was set. On some +window systems, it can also be a display name or a terminal. + +The class of a device is one of the following symbols: + + `core-keyboard' means the device is a keyboard-like device, but + any other characteristics are unknown. + + `core-pointer' means the device is a pointing device, but any + other characteristics are unknown. + + `mouse' means the device is a computer mouse. + + `trackpoint' means the device is a joystick or trackpoint. + + `eraser' means the device is an eraser, which is typically the + other end of a stylus on a graphics tablet. + + `pen' means the device is a stylus or some other similar + device. + + `puck' means the device is a device similar to a mouse, but + reports absolute coordinates. + + `power-button' means the device is a power button, volume + button, or some similar control. + + `keyboard' means the device is a keyboard. + + `touchscreen' means the device is a touchscreen. + + `pad' means the device is a collection of buttons and rings and + strips commonly found in drawing tablets. + + `touchpad' means the device is an indirect touch device, such + as a touchpad. + + `piano' means the device is a piano, or some other kind of + musical instrument. + + `test' means the device is used by the XTEST extension to + report input. + +It can also be nil, which means the class of the device could not +be determined. Individual window systems may also return other +symbols." + (let ((frame-type (framep-on-display frame))) + (cond ((eq frame-type 'x) + (x-device-class name)) + (t (cond + ((string= name "Virtual core pointer") + 'core-pointer) + ((string= name "Virtual core keyboard") + 'core-keyboard)))))) + ;;;; Frame geometry values diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index a71ae87e215..ac8b1f5df32 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1583,6 +1583,38 @@ frames on all displays." (dnd-handle-movement position) (redisplay)) +(defun x-device-class (name) + "Return the device class of NAME. +Users should not call this function; see `device-class' instead." + (let ((downcased-name (downcase name))) + (cond + ((string-match-p "XTEST" name) 'test) + ((string= "Virtual core pointer" name) 'core-pointer) + ((string= "Virtual core keyboard" name) 'core-keyboard) + ((string-match-p "eraser" downcased-name) 'eraser) + ((string-match-p " pad" downcased-name) 'pad) + ((or (or (string-match-p "wacom" downcased-name) + (string-match-p "pen" downcased-name)) + (string-match-p "stylus" downcased-name)) + 'pen) + ((or (string-prefix-p "xwayland-touch:" name) + (string-match-p "touchscreen" downcased-name)) + 'touchscreen) + ((or (string-match-p "trackpoint" downcased-name) + (string-match-p "stick" downcased-name)) + 'trackpoint) + ((or (string-match-p "mouse" downcased-name) + (string-match-p "optical" downcased-name) + (string-match-p "pointer" downcased-name)) + 'mouse) + ((string-match-p "cursor" downcased-name) 'puck) + ((string-match-p "keyboard" downcased-name) 'keyboard) + ((string-match-p "button" downcased-name) 'power-button) + ((string-match-p "touchpad" downcased-name) 'touchpad) + ((or (string-match-p "midi" downcased-name) + (string-match-p "piano" downcased-name)) + 'piano)))) + (setq x-dnd-movement-function #'x-dnd-movement) (setq x-dnd-unsupported-drop-function #'x-dnd-handle-unsupported-drop) -- 2.39.5