diff options
author | Po Lu <luangruo@yahoo.com> | 2022-04-08 09:47:25 +0800 |
---|---|---|
committer | Po Lu <luangruo@yahoo.com> | 2022-04-08 09:47:25 +0800 |
commit | 1a1c5a6884a60ef2ffa98f3ee4af793eac985f80 (patch) | |
tree | 2697c3f6bd928783dff1e214fdf2d26e91819f17 /lisp/term | |
parent | 6ac7fa7e78b84a6fbdf12a63d927ad55bacd8d91 (diff) | |
download | emacs-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.el | 32 |
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) |