summaryrefslogtreecommitdiff
path: root/lisp/term
diff options
context:
space:
mode:
authorPo Lu <luangruo@yahoo.com>2022-04-08 09:47:25 +0800
committerPo Lu <luangruo@yahoo.com>2022-04-08 09:47:25 +0800
commit1a1c5a6884a60ef2ffa98f3ee4af793eac985f80 (patch)
tree2697c3f6bd928783dff1e214fdf2d26e91819f17 /lisp/term
parent6ac7fa7e78b84a6fbdf12a63d927ad55bacd8d91 (diff)
downloademacs-1a1c5a6884a60ef2ffa98f3ee4af793eac985f80.tar.gz
emacs-1a1c5a6884a60ef2ffa98f3ee4af793eac985f80.tar.bz2
emacs-1a1c5a6884a60ef2ffa98f3ee4af793eac985f80.zip
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.
Diffstat (limited to 'lisp/term')
-rw-r--r--lisp/term/x-win.el32
1 files changed, 32 insertions, 0 deletions
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)