diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/frame.el | 1 | ||||
| -rw-r--r-- | lisp/term/pgtk-win.el | 1 | ||||
| -rw-r--r-- | lisp/term/x-win.el | 71 |
3 files changed, 38 insertions, 35 deletions
diff --git a/lisp/frame.el b/lisp/frame.el index 6bedffc358b..1d7784dc769 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2516,6 +2516,7 @@ symbols." ((eq frame-type 'pgtk) (pgtk-device-class name)) (t (cond + ((not name) nil) ((string= name "Virtual core pointer") 'core-pointer) ((string= name "Virtual core keyboard") diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index b93e259d82a..20f15739167 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -371,6 +371,7 @@ This uses `icon-map-list' to map icon file names to stock icon names." "Return the device class of NAME. Users should not call this function; see `device-class' instead." (cond + ((not name) nil) ((string-match-p "XTEST" name) 'test) ((string= "Virtual core pointer" name) 'core-pointer) ((string= "Virtual core keyboard" name) 'core-keyboard) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 38266baa969..9d3e7803650 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1573,41 +1573,42 @@ frames on all displays." (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) - ((or (string-match-p "keyboard" downcased-name) - ;; One of my cheap keyboards is really named this... - (string= name "USB USB Keykoard")) - '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) - ((or (string-match-p "wskbd" downcased-name) ; NetBSD/OpenBSD - (and (string-match-p "/dev" downcased-name) - (string-match-p "kbd" downcased-name))) - 'keyboard)))) + (and name + (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) + ((or (string-match-p "keyboard" downcased-name) + ;; One of my cheap keyboards is really named this... + (string= name "USB USB Keykoard")) + '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) + ((or (string-match-p "wskbd" downcased-name) ; NetBSD/OpenBSD + (and (string-match-p "/dev" downcased-name) + (string-match-p "kbd" downcased-name))) + 'keyboard))))) (setq x-dnd-movement-function #'x-dnd-movement) (setq x-dnd-unsupported-drop-function #'x-dnd-handle-unsupported-drop) |