(frames-on-display-list, framep-on-display): New functions.

(display-mouse-p, display-popup-menus-p, display-graphic-p)
(display-selections-p, display-screens, display-pixel-width)
(display-pixel-height, display-mm-width, display-mm-height)
(display-backing-store, display-save-under, display-planes)
(display-color-cells, display-visual-class): New functions.

1 files changed, 172 insertions, 0 deletions

diff --git a/lisp/frame.el b/lisp/frame.el
index d6bc880a85e..a9d4121949b 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -508,6 +508,27 @@ on `after-make-frame-functions' are run with one arg, the newly created frame."
    (function (lambda (frame)
                (eq frame (window-frame (minibuffer-window frame)))))))
 
+(defun frames-on-display-list (&optional display)
+  "Return a list of all frames on DISPLAY.
+DISPLAY is a name of a display, a string of the form HOST:SERVER.SCREEN.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
+  (let* ((display (or display
+                      (cdr (assoc 'display (frame-parameters)))))
+         (func
+          (function (lambda (frame)
+                      (eq (cdr (assoc 'display (frame-parameters frame)))
+                          display)))))
+    (filtered-frame-list func)))
+
+(defun framep-on-display (&optional display)
+  "Return the type of frames on DISPLAY.
+DISPLAY may be a display name or a frame.  If it is a frame, its type is
+returned.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display.
+All frames on a given display are of the same type."
+  (or (framep display)
+      (framep (car (frames-on-display-list display)))))
+
 (defun frame-remove-geometry-params (param-list)
   "Return the parameter list PARAM-LIST, but with geometry specs removed.
 This deletes all bindings in PARAM-LIST for `top', `left', `width',
@@ -768,6 +789,157 @@ one frame, otherwise the name is displayed on the frame's caption bar."
   (modify-frame-parameters (selected-frame)
                            (list (cons 'name name))))
 
+;;;; Frame/display capabilities.
+(defun display-mouse-p (&optional display)
+  "Return non-nil if DISPLAY has a mouse available.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display)."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((eq frame-type 'pc)
+      (msdos-mouse-p))
+     ((eq system-type 'windows-nt)
+      (> w32-num-mouse-buttons 0))
+     ((memq frame-type '(x mac))
+      t)    ;; We assume X and Mac *always* have a pointing device
+     (t
+      (featurep 'xt-mouse)))))
+
+(defun display-popup-menus-p (&optional display)
+  "Return non-nil if popup menus are supported on DISPLAY.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display).
+Support for popup menus requires that the mouse be available."
+  (and
+   (let ((frame-type (framep-on-display display)))
+     (memq frame-type '(x w32 pc mac)))
+   (display-mouse-p display)))
+
+(defun display-graphic-p (&optional display)
+  "Return non-nil if DISPLAY is a graphic display.
+Graphical displays are those which are capable of displaying several
+frames and several different fonts at once.  This is true for displays
+that use a window system such as X, and false for text-only terminals.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display)."
+  (not (null (memq (framep-on-display display) '(x w32 mac)))))
+
+(defun display-selections-p (&optional display)
+  "Return non-nil if DISPLAY supports selections.
+A selection is a way to transfer text or other data between programs
+via special system buffers called `selection' or `cut buffer' or
+`clipboard'.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display)."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((eq frame-type 'pc)
+      ;; MS-DOG frames support selections when Emacs runs inside
+      ;; the Windows' DOS Box.
+      (not (null dos-windows-version)))
+     ((memq frame-type '(x w32 mac))
+      t)    ;; FIXME?
+     (t
+      nil))))
+
+(defun display-screens (&optional display)
+  "Return the number of screens associated with DISPLAY."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32))
+      (x-display-screens display))
+     (t ;; FIXME: is this correct for the Mac?
+      1))))
+
+(defun display-pixel-height (&optional display)
+  "Return the height of DISPLAY's screen in pixels.
+For character terminals, each character counts as a single pixel."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-pixel-height display))
+     (t
+      (frame-height (if (framep display) display (selected-frame)))))))
+
+(defun display-pixel-width (&optional display)
+  "Return the width of DISPLAY's screen in pixels.
+For character terminals, each character counts as a single pixel."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-pixel-width display))
+     (t
+      (frame-width (if (framep display) display (selected-frame)))))))
+
+(defun display-mm-height (&optional display)
+  "Return the height of DISPLAY's screen in millimeters.
+If the information is unavailable, value is nil."
+  (and (memq (framep-on-display display) '(x w32 mac))
+       (x-display-mm-height display)))
+
+(defun display-mm-width (&optional display)
+  "Return the width of DISPLAY's screen in millimeters.
+If the information is unavailable, value is nil."
+  (and (memq (framep-on-display display) '(x w32 mac))
+       (x-display-mm-width display)))
+
+(defun display-backing-store (&optional display)
+  "Return the backing store capability of DISPLAY's screen.
+The value may be `always', `when-mapped', `not-useful', or nil if
+the question is inapplicable to a certain kind of display."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-backing-store display))
+     (t
+      'not-useful))))
+
+(defun display-save-under (&optional display)
+  "Return non-nil if DISPLAY's screen supports the SaveUnder feature."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-save-under display))
+     (t
+      'not-useful))))
+
+(defun display-planes (&optional display)
+  "Return the number of planes supported by DISPLAY."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-planes display))
+     ((eq frame-type 'pc)
+      4)
+     (t
+      (truncate (log (length (tty-color-alist)) 2))))))
+
+(defun display-color-cells (&optional display)
+  "Return the number of color cells supported by DISPLAY."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-color-cells display))
+     ((eq frame-type 'pc)
+      16)
+     (t
+      (length (tty-color-alist))))))
+
+(defun display-visual-class (&optional display)
+  "Returns the visual class of DISPLAY.
+The value is one of the symbols `static-gray', `gray-scale',
+`static-color', `pseudo-color', `true-color', or `direct-color'."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-visual-class display))
+     ((and (memq frame-type '(pc t))
+           (tty-display-color-p display))
+      'static-color)
+     (t
+      'static-gray))))
+
+
 ;;;; Aliases for backward compatibility with Emacs 18.
 (defalias 'screen-height 'frame-height)
 (defalias 'screen-width 'frame-width)