Mercurial > hg > xemacs-beta

comparison lisp/frame.el @ 4546:44129f301385

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Make functions in frame.el more general. (This results in better behaviour on Carbon, notably.) 2008-12-30 Aidan Kehoe <kehoea@parhasard.net> * frame.el (display-mouse-p): (display-popup-menus-p): (display-images-p): (display-selections-p): (display-visual-class): Make all these functions more general, do not hard code device type symbols where that is inappropriate.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 30 Dec 2008 14:22:29 +0000
parents bd28481bb0e1
children 732e3243f2e4
comparison
equal deleted inserted replaced
4545:8775d3b54874 4546:44129f301385
1177 ;;;; Frame/display capabilities. 1177 ;;;; Frame/display capabilities.
1178 (defun display-mouse-p (&optional display) 1178 (defun display-mouse-p (&optional display)
1179 "Return non-nil if DISPLAY has a mouse available. 1179 "Return non-nil if DISPLAY has a mouse available.
1180 DISPLAY can be a frame, a device, a console, or nil (meaning the 1180 DISPLAY can be a frame, a device, a console, or nil (meaning the
1181 selected frame)." 1181 selected frame)."
1182 (case (framep-on-display display) 1182 (let (type)
1183 ;; We assume X, NeXTstep, and GTK *always* have a pointing device 1183 (setq display (display-device display)
1184 ((x ns gtk) t) 1184 type (device-type display))
1185 (mswindows (> (declare-boundp mswindows-num-mouse-buttons) 0)) 1185 (cond
1186 (tty 1186 ((eq 'mswindows type)
1187 (> (declare-boundp mswindows-num-mouse-buttons) 0))
1188 ((device-on-window-system-p display)
1189 ;; We assume X, NeXTstep, and GTK and the rest always have a pointing
1190 ;; device.
1191 t)
1192 ((eq 'tty type)
1187 (and-fboundp 'gpm-is-supported-p 1193 (and-fboundp 'gpm-is-supported-p
1188 (gpm-is-supported-p (display-device display)))) 1194 (gpm-is-supported-p display)))
1189 (t nil))) 1195 (t nil))))
1190 1196
1191 (defun display-popup-menus-p (&optional display) 1197 (defun display-popup-menus-p (&optional display)
1192 "Return non-nil if popup menus are supported on DISPLAY. 1198 "Return non-nil if popup menus are supported on DISPLAY.
1193 DISPLAY can be a frame, a device, a console, or nil (meaning the selected 1199 DISPLAY can be a frame, a device, a console, or nil (meaning the selected
1194 frame). Support for popup menus requires that the mouse be available." 1200 frame). Support for popup menus requires that the mouse be available."
1201 (setq display (display-device display))
1195 (and 1202 (and
1196 (memq (framep-on-display display) '(x ns gtk mswindows)) 1203 (featurep 'menubar)
1204 (device-on-window-system-p display)
1197 (display-mouse-p display))) 1205 (display-mouse-p display)))
1198 1206
1199 (defun display-graphic-p (&optional display) 1207 (defun display-graphic-p (&optional display)
1200 "Return non-nil if DISPLAY is a graphic display. 1208 "Return non-nil if DISPLAY is a graphic display.
1201 Graphical displays are those which are capable of displaying several 1209 Graphical displays are those which are capable of displaying several
1202 frames and several different fonts at once. This is true for displays 1210 frames and several different fonts at once. This is true for displays
1203 that use a window system such as X, and false for text-only terminals. 1211 that use a window system such as X, and false for text-only terminals.
1204 DISPLAY can be a frame, a device, a console, or nil (meaning the selected 1212 DISPLAY can be a frame, a device, a console, or nil (meaning the selected
1205 frame)." 1213 frame)."
1206 (memq (framep-on-display display) '(x ns gtk mswindows))) 1214 (device-on-window-system-p display))
1207 1215
1208 (defun display-images-p (&optional display) 1216 (defun display-images-p (&optional display)
1209 "Return non-nil if DISPLAY can display images. 1217 "Return non-nil if DISPLAY can display images.
1210 DISPLAY can be a frame, a device, a console, or nil (meaning the selected 1218 DISPLAY can be a frame, a device, a console, or nil (meaning the selected
1211 frame)." 1219 frame)."
1212 (display-graphic-p display)) 1220 (and (memq (image-instance-type (specifier-instance
1221 (glyph-image xemacs-logo)
1222 display))
1223 '(color-pixmap mono-pixmap))
1224 t))
1213 1225
1214 (defalias 'display-multi-frame-p 'display-graphic-p) 1226 (defalias 'display-multi-frame-p 'display-graphic-p)
1215 (defalias 'display-multi-font-p 'display-graphic-p) 1227 (defalias 'display-multi-font-p 'display-graphic-p)
1216 1228
1217 (defun display-selections-p (&optional display) 1229 (defun display-selections-p (&optional display)
1219 A selection is a way to transfer text or other data between programs 1231 A selection is a way to transfer text or other data between programs
1220 via special system buffers called `selection' or `cut buffer' or 1232 via special system buffers called `selection' or `cut buffer' or
1221 `clipboard'. 1233 `clipboard'.
1222 DISPLAY can be a frame, a device, a console, or nil (meaning the selected 1234 DISPLAY can be a frame, a device, a console, or nil (meaning the selected
1223 frame)." 1235 frame)."
1224 (memq (framep-on-display display) '(x ns gtk mswindows))) 1236 (or
1237 (device-on-window-system-p display)
1238 ;; GPM supports #'get-selection-foreign, but not #'own-selection.
1239 (and-fboundp 'gpm-is-supported-p
1240 (gpm-is-supported-p display))))
1225 1241
1226 (defun display-screens (&optional display) 1242 (defun display-screens (&optional display)
1227 "Return the number of screens associated with DISPLAY." 1243 "Return the number of screens associated with DISPLAY."
1228 (device-num-screens (display-device display))) 1244 (device-num-screens (display-device display)))
1229 1245
1267 1283
1268 (defun display-visual-class (&optional display) 1284 (defun display-visual-class (&optional display)
1269 "Returns the visual class of DISPLAY. 1285 "Returns the visual class of DISPLAY.
1270 The value is one of the symbols `static-gray', `gray-scale', 1286 The value is one of the symbols `static-gray', `gray-scale',
1271 `static-color', `pseudo-color', `true-color', or `direct-color'." 1287 `static-color', `pseudo-color', `true-color', or `direct-color'."
1272 (case (framep-on-display display) 1288 (let (type planes)
1273 (x (declare-fboundp (x-display-visual-class (display-device display)))) 1289 (setq display (display-device display)
1274 (gtk (declare-fboundp (gtk-display-visual-class (display-device display)))) 1290 type (device-type display))
1275 (mswindows (let ((planes (display-planes display))) 1291 (cond
1276 (cond ((eq planes 1) 'static-gray) 1292 ((eq 'x type)
1277 ((eq planes 4) 'static-color) 1293 (declare-fboundp (x-display-visual-class display)))
1278 ((> planes 8) 'true-color) 1294 ((eq 'gtk type)
1279 (t 'pseudo-color)))) 1295 (declare-fboundp (gtk-display-visual-class display)))
1280 (t 'static-gray))) 1296 ((device-on-window-system-p display)
1297 (setq planes (display-planes display))
1298 (cond ((eq planes 1) 'static-gray)
1299 ((eq planes 4) 'static-color)
1300 ((> planes 8) 'true-color)
1301 (t 'pseudo-color)))
1302 (t 'static-gray))))
1281 1303
1282 1304
1283 ;; XEmacs change: omit the Emacs 18 compatibility functions: 1305 ;; XEmacs change: omit the Emacs 18 compatibility functions:
1284 ;; screen-height, screen-width, set-screen-height, and set-screen-width. 1306 ;; screen-height, screen-width, set-screen-height, and set-screen-width.
1285 1307