diff lisp/w3/css.el @ 118:7d55a9ba150c r20-1b11

Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents 8d2a9b52c682
children 34a5b81f86ba
line wrap: on
line diff
--- a/lisp/w3/css.el	Mon Aug 13 09:23:08 2007 +0200
+++ b/lisp/w3/css.el	Mon Aug 13 09:24:17 2007 +0200
@@ -1,7 +1,7 @@
 ;;; css.el -- Cascading Style Sheet parser
 ;; Author: wmperry
-;; Created: 1997/03/25 03:35:09
-;; Version: 1.33
+;; Created: 1997/04/01 19:21:41
+;; Version: 1.34
 ;; Keywords: 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -714,8 +714,62 @@
   (css-replace-regexp "[ \t\r]+$" "")	; Nuke whitespace at end of line
   (goto-char (point-min)))
 
+(if css-running-xemacs
+    (defun css-color-light-p (color-or-face)
+      (let (face color)
+	(cond
+	 ((or (facep color-or-face)
+	      (and (symbolp color-or-face)
+		   (find-face color-or-face)))
+	  (setq color (specifier-instance (face-background color-or-face))))
+	 ((color-instance-p color-or-face)
+	  (setq color color-or-face))
+	 ((color-specifier-p color-or-face)
+	  (setq color (specifier-instance color-or-face)))
+	 ((stringp color-or-face)
+	  (setq color (make-color-instance color-or-face)))
+	 (t (signal 'wrong-type-argument 'color-or-face-p)))
+	(if color
+	    (not (< (apply '+ (color-instance-rgb-components color))
+		    (/ (apply '+ (color-instance-rgb-components
+				  (make-color-instance "white"))) 3)))
+	  t)))
+  (defun css-color-values (color)
+    (cond
+     ((eq window-system 'x)
+      (x-color-values color))
+     ((eq window-system 'pm)
+      (pm-color-values color))
+     ((eq window-system 'ns)
+      (ns-color-values color))
+     (t nil)))
+  (defun css-color-light-p (color-or-face)
+    (let (colors)
+      (cond
+       ((null window-system)
+	nil)
+       ((facep color-or-face)
+	(setq color-or-face (face-background color-or-face))
+	(if (null color-or-face)
+	    (setq color-or-face (cdr-safe
+				 (assq 'background-color (frame-parameters)))))
+	(setq colors (css-color-values color-or-face)))
+       ((stringp color-or-face)
+	(setq colors (css-color-values color-or-face)))
+       ((font-rgb-color-p color-or-face)
+	(setq colors (list (font-rgb-color-red color-or-face)
+			   (font-rgb-color-green color-or-face)
+			   (font-rgb-color-blue color-or-face))))
+       (t
+	(signal 'wrong-type-argument 'color-or-face-p)))
+      (not (< (apply '+ colors)
+	      (/ (apply '+ (css-color-values "white")) 3)))))
+  )
+
 (defun css-active-device-types (&optional device)
-  (let ((types (list 'all (if css-running-xemacs 'xemacs 'emacs)))
+  (let ((types (list 'all
+		     (if css-running-xemacs 'xemacs 'emacs)
+		     (if (css-color-light-p 'default) 'light 'dark)))
 	(type (device-type device)))
     (cond
      ((featurep 'emacspeak)