Mercurial > hg > xemacs-beta
diff lisp/w3/font.el @ 32:e04119814345 r19-15b99
Import from CVS: tag r19-15b99
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:52:56 +0200 |
parents | ec9a17fef872 |
children | 1a767b41a199 |
line wrap: on
line diff
--- a/lisp/w3/font.el Mon Aug 13 08:52:30 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 08:52:56 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -974,9 +974,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)) @@ -1069,15 +1070,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)