From 3ed9a1b0be024523703397b91c1b2ba66d848596 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 21 Sep 2022 19:49:31 +0800 Subject: [PATCH] Fix handling of nil device names * lisp/frame.el (device-class): * lisp/term/pgtk-win.el (pgtk-device-class): * lisp/term/x-win.el (x-device-class): Handle `nil' correctly. (bug#57969) --- lisp/frame.el | 1 + lisp/term/pgtk-win.el | 1 + 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) -- 2.39.2