Mercurial > hg > xemacs-beta
diff lisp/w3/font.el @ 110:fe104dbd9147 r20-1b7
Import from CVS: tag r20-1b7
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:19:45 +0200 |
parents | 360340f9fd5f |
children | 8619ce7e4c50 |
line wrap: on
line diff
--- a/lisp/w3/font.el Mon Aug 13 09:18:41 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 09:19:45 2007 +0200 @@ -1,7 +1,7 @@ ;;; font.el --- New font model ;; Author: wmperry -;; Created: 1997/03/03 15:15:42 -;; Version: 1.34 +;; Created: 1997/03/10 15:18:19 +;; Version: 1.36 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -977,9 +977,10 @@ (list r g b) )) (defsubst font-rgb-color-p (obj) - (and (vectorp obj) - (= (length obj) 4) - (eq (aref obj 0) 'rgb))) + (or (and (vectorp obj) + (= (length obj) 4) + (eq (aref obj 0) 'rgb)) + (string-match "^#[0-9a-fA-F]+$" obj))) (defsubst font-rgb-color-red (obj) (aref obj 1)) (defsubst font-rgb-color-green (obj) (aref obj 2)) @@ -1072,15 +1073,21 @@ "Return an RGB tuple, given any form of input. If an error occurs, black is returned." (case (device-type device) - ((x pm win32) + ((x pm) (apply 'format "#%02x%02x%02x" (font-color-rgb-components color))) + (win32 + (let* ((rgb (font-color-rgb-components color)) + (color (apply 'format "#%02x%02x%02x" rgb))) + (win32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) + color)) (tty (apply 'font-tty-find-closest-color (font-color-rgb-components color))) (ns (let ((vals (mapcar (function (lambda (x) (>> x 8))) (font-color-rgb-components color)))) (apply 'format "RGB%02x%02x%02xff" vals))) - (otherwise "black"))) + (otherwise + color))) (defun font-set-face-background (&optional face color &rest args) (interactive)