Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents 8d2a9b52c682
children 34a5b81f86ba
comparison
equal deleted inserted replaced
117:578fd4947a72 118:7d55a9ba150c
1 ;;; css.el -- Cascading Style Sheet parser 1 ;;; css.el -- Cascading Style Sheet parser
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/25 03:35:09 3 ;; Created: 1997/04/01 19:21:41
4 ;; Version: 1.33 4 ;; Version: 1.34
5 ;; Keywords: 5 ;; Keywords:
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
712 (delete-matching-lines "^[ \t\r]*$") ; Nuke blank lines 712 (delete-matching-lines "^[ \t\r]*$") ; Nuke blank lines
713 (css-replace-regexp "^[ \t\r]+" "") ; Nuke whitespace at beg. of line 713 (css-replace-regexp "^[ \t\r]+" "") ; Nuke whitespace at beg. of line
714 (css-replace-regexp "[ \t\r]+$" "") ; Nuke whitespace at end of line 714 (css-replace-regexp "[ \t\r]+$" "") ; Nuke whitespace at end of line
715 (goto-char (point-min))) 715 (goto-char (point-min)))
716 716
717 (if css-running-xemacs
718 (defun css-color-light-p (color-or-face)
719 (let (face color)
720 (cond
721 ((or (facep color-or-face)
722 (and (symbolp color-or-face)
723 (find-face color-or-face)))
724 (setq color (specifier-instance (face-background color-or-face))))
725 ((color-instance-p color-or-face)
726 (setq color color-or-face))
727 ((color-specifier-p color-or-face)
728 (setq color (specifier-instance color-or-face)))
729 ((stringp color-or-face)
730 (setq color (make-color-instance color-or-face)))
731 (t (signal 'wrong-type-argument 'color-or-face-p)))
732 (if color
733 (not (< (apply '+ (color-instance-rgb-components color))
734 (/ (apply '+ (color-instance-rgb-components
735 (make-color-instance "white"))) 3)))
736 t)))
737 (defun css-color-values (color)
738 (cond
739 ((eq window-system 'x)
740 (x-color-values color))
741 ((eq window-system 'pm)
742 (pm-color-values color))
743 ((eq window-system 'ns)
744 (ns-color-values color))
745 (t nil)))
746 (defun css-color-light-p (color-or-face)
747 (let (colors)
748 (cond
749 ((null window-system)
750 nil)
751 ((facep color-or-face)
752 (setq color-or-face (face-background color-or-face))
753 (if (null color-or-face)
754 (setq color-or-face (cdr-safe
755 (assq 'background-color (frame-parameters)))))
756 (setq colors (css-color-values color-or-face)))
757 ((stringp color-or-face)
758 (setq colors (css-color-values color-or-face)))
759 ((font-rgb-color-p color-or-face)
760 (setq colors (list (font-rgb-color-red color-or-face)
761 (font-rgb-color-green color-or-face)
762 (font-rgb-color-blue color-or-face))))
763 (t
764 (signal 'wrong-type-argument 'color-or-face-p)))
765 (not (< (apply '+ colors)
766 (/ (apply '+ (css-color-values "white")) 3)))))
767 )
768
717 (defun css-active-device-types (&optional device) 769 (defun css-active-device-types (&optional device)
718 (let ((types (list 'all (if css-running-xemacs 'xemacs 'emacs))) 770 (let ((types (list 'all
771 (if css-running-xemacs 'xemacs 'emacs)
772 (if (css-color-light-p 'default) 'light 'dark)))
719 (type (device-type device))) 773 (type (device-type device)))
720 (cond 774 (cond
721 ((featurep 'emacspeak) 775 ((featurep 'emacspeak)
722 (setq types (cons 'speech types))) 776 (setq types (cons 'speech types)))
723 ((eq type 'tty) 777 ((eq type 'tty)