[COMMIT] Make functions in frame.el more general.

[Aidan Kehoe]

APPROVE COMMIT 

NOTE; this patch has been committed. 

# HG changeset patch
# User Aidan Kehoe <kehoea at parhasard.net>
# Date 1230646949 0
# Node ID 44129f301385e892320cacced2696acdbdf6a1df
# Parent  8775d3b5487437a87fa8c75338b7c3fc6cb7a2e1
Make functions in frame.el more general.

(This results in better behaviour on Carbon, notably.)

2008-12-30  Aidan Kehoe  <kehoea at 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.

diff -r 8775d3b54874 -r 44129f301385 lisp/ChangeLog
--- a/lisp/ChangeLog	Mon Dec 29 23:36:00 2008 +0900
+++ b/lisp/ChangeLog	Tue Dec 30 14:22:29 2008 +0000
@@ -1,3 +1,13 @@
+2008-12-30  Aidan Kehoe  <kehoea at 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. 
+
 2008-12-27  Aidan Kehoe  <kehoea at parhasard.net>
 
 	* loadhist.el (symbol-file): 
diff -r 8775d3b54874 -r 44129f301385 lisp/frame.el
--- a/lisp/frame.el	Mon Dec 29 23:36:00 2008 +0900
+++ b/lisp/frame.el	Tue Dec 30 14:22:29 2008 +0000
@@ -1179,21 +1179,29 @@
   "Return non-nil if DISPLAY has a mouse available.
 DISPLAY can be a frame, a device, a console, or nil (meaning the
 selected frame)."
-  (case (framep-on-display display)
-    ;; We assume X, NeXTstep, and GTK *always* have a pointing device
-    ((x ns gtk) t)
-    (mswindows (> (declare-boundp mswindows-num-mouse-buttons) 0))
-    (tty
+  (let (type)
+    (setq display (display-device display)
+          type (device-type display))
+    (cond
+     ((eq 'mswindows type)
+      (> (declare-boundp mswindows-num-mouse-buttons) 0))
+     ((device-on-window-system-p display)
+      ;; We assume X, NeXTstep, and GTK and the rest always have a pointing
+      ;; device. 
+      t)
+    ((eq 'tty type)
      (and-fboundp 'gpm-is-supported-p
-       (gpm-is-supported-p (display-device display))))
-    (t nil)))
+       (gpm-is-supported-p display)))
+    (t nil))))
 
 (defun display-popup-menus-p (&optional display)
   "Return non-nil if popup menus are supported on DISPLAY.
 DISPLAY can be a frame, a device, a console, or nil (meaning the selected
 frame).  Support for popup menus requires that the mouse be available."
+  (setq display (display-device display))
   (and
-   (memq (framep-on-display display) '(x ns gtk mswindows))
+   (featurep 'menubar)
+   (device-on-window-system-p display)
    (display-mouse-p display)))
 
 (defun display-graphic-p (&optional display)
@@ -1203,13 +1211,17 @@
 that use a window system such as X, and false for text-only terminals.
 DISPLAY can be a frame, a device, a console, or nil (meaning the selected
 frame)."
-  (memq (framep-on-display display) '(x ns gtk mswindows)))
+  (device-on-window-system-p display))
 
 (defun display-images-p (&optional display)
   "Return non-nil if DISPLAY can display images.
 DISPLAY can be a frame, a device, a console, or nil (meaning the selected
 frame)."
-  (display-graphic-p display))
+  (and (memq (image-instance-type (specifier-instance
+                                   (glyph-image xemacs-logo)
+                                   display))
+             '(color-pixmap mono-pixmap))
+       t))
 
 (defalias 'display-multi-frame-p 'display-graphic-p)
 (defalias 'display-multi-font-p 'display-graphic-p)
@@ -1221,7 +1233,11 @@
 `clipboard'.
 DISPLAY can be a frame, a device, a console, or nil (meaning the selected
 frame)."
-  (memq (framep-on-display display) '(x ns gtk mswindows)))
+  (or 
+   (device-on-window-system-p display)
+   ;; GPM supports #'get-selection-foreign, but not #'own-selection.
+   (and-fboundp 'gpm-is-supported-p
+     (gpm-is-supported-p display))))   
 
 (defun display-screens (&optional display)
   "Return the number of screens associated with DISPLAY."
@@ -1269,15 +1285,21 @@
   "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'."
-  (case (framep-on-display display)
-    (x (declare-fboundp (x-display-visual-class (display-device display))))
-    (gtk (declare-fboundp (gtk-display-visual-class (display-device display))))
-    (mswindows (let ((planes (display-planes display)))
-		 (cond ((eq planes 1) 'static-gray)
-		       ((eq planes 4) 'static-color)
-		       ((> planes 8) 'true-color)
-		       (t 'pseudo-color))))
-    (t 'static-gray)))
+  (let (type planes)
+    (setq display (display-device display)
+          type (device-type display))
+    (cond
+     ((eq 'x type)
+      (declare-fboundp (x-display-visual-class display)))
+     ((eq 'gtk type)
+      (declare-fboundp (gtk-display-visual-class display)))
+     ((device-on-window-system-p display)
+      (setq planes (display-planes display))
+      (cond ((eq planes 1) 'static-gray)
+            ((eq planes 4) 'static-color)
+            ((> planes 8) 'true-color)
+            (t 'pseudo-color)))
+     (t 'static-gray))))
 
 
 ;; XEmacs change: omit the Emacs 18 compatibility functions:


-- 
¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir
precipitadamente de la aldea por culpa de la escasez de rinocerontes?