Mercurial > hg > xemacs-beta

comparison lisp/w3/font.el @ 32:e04119814345 r19-15b99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b99
author cvs
date Mon, 13 Aug 2007 08:52:56 +0200
parents ec9a17fef872
children 1a767b41a199
comparison
equal deleted inserted replaced
31:b9328a10c56c 32:e04119814345
1 ;;; font.el --- New font model 1 ;;; font.el --- New font model
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/03 15:15:42 3 ;; Created: 1997/03/10 15:18:19
4 ;; Version: 1.34 4 ;; Version: 1.36
5 ;; Keywords: faces 5 ;; Keywords: faces
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1995, 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.
972 g 0 972 g 0
973 b 0))) 973 b 0)))
974 (list r g b) )) 974 (list r g b) ))
975 975
976 (defsubst font-rgb-color-p (obj) 976 (defsubst font-rgb-color-p (obj)
977 (and (vectorp obj) 977 (or (and (vectorp obj)
978 (= (length obj) 4) 978 (= (length obj) 4)
979 (eq (aref obj 0) 'rgb))) 979 (eq (aref obj 0) 'rgb))
980 (string-match "^#[0-9a-fA-F]+$" obj)))
980 981
981 (defsubst font-rgb-color-red (obj) (aref obj 1)) 982 (defsubst font-rgb-color-red (obj) (aref obj 1))
982 (defsubst font-rgb-color-green (obj) (aref obj 2)) 983 (defsubst font-rgb-color-green (obj) (aref obj 2))
983 (defsubst font-rgb-color-blue (obj) (aref obj 3)) 984 (defsubst font-rgb-color-blue (obj) (aref obj 3))
984 985
1067 1068
1068 (defun font-normalize-color (color &optional device) 1069 (defun font-normalize-color (color &optional device)
1069 "Return an RGB tuple, given any form of input. If an error occurs, black 1070 "Return an RGB tuple, given any form of input. If an error occurs, black
1070 is returned." 1071 is returned."
1071 (case (device-type device) 1072 (case (device-type device)
1072 ((x pm win32) 1073 ((x pm)
1073 (apply 'format "#%02x%02x%02x" (font-color-rgb-components color))) 1074 (apply 'format "#%02x%02x%02x" (font-color-rgb-components color)))
1075 (win32
1076 (let* ((rgb (font-color-rgb-components color))
1077 (color (apply 'format "#%02x%02x%02x" rgb)))
1078 (win32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color)
1079 color))
1074 (tty 1080 (tty
1075 (apply 'font-tty-find-closest-color (font-color-rgb-components color))) 1081 (apply 'font-tty-find-closest-color (font-color-rgb-components color)))
1076 (ns 1082 (ns
1077 (let ((vals (mapcar (function (lambda (x) (>> x 8))) 1083 (let ((vals (mapcar (function (lambda (x) (>> x 8)))
1078 (font-color-rgb-components color)))) 1084 (font-color-rgb-components color))))
1079 (apply 'format "RGB%02x%02x%02xff" vals))) 1085 (apply 'format "RGB%02x%02x%02xff" vals)))
1080 (otherwise "black"))) 1086 (otherwise
1087 color)))
1081 1088
1082 (defun font-set-face-background (&optional face color &rest args) 1089 (defun font-set-face-background (&optional face color &rest args)
1083 (interactive) 1090 (interactive)
1084 (condition-case nil 1091 (condition-case nil
1085 (cond 1092 (cond