comparison lisp/w3/font.el @ 46:6a22abad6937 r19-15

Import from CVS: tag r19-15
author cvs
date Mon, 13 Aug 2007 08:55:31 +0200
parents 1a767b41a199
children 131b0175ea99
comparison
equal deleted inserted replaced
45:7705b7aa3b8a 46:6a22abad6937
1 ;;; font.el --- New font model 1 ;;; font.el --- New font model
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/19 18:28:10 3 ;; Created: 1997/03/26 20:08:55
4 ;; Version: 1.38 4 ;; Version: 1.40
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.
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 (or (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)))
981 980
982 (defsubst font-rgb-color-red (obj) (aref obj 1)) 981 (defsubst font-rgb-color-red (obj) (aref obj 1))
983 (defsubst font-rgb-color-green (obj) (aref obj 2)) 982 (defsubst font-rgb-color-green (obj) (aref obj 2))
984 (defsubst font-rgb-color-blue (obj) (aref obj 3)) 983 (defsubst font-rgb-color-blue (obj) (aref obj 3))
985 984
1088 1087
1089 (defun font-set-face-background (&optional face color &rest args) 1088 (defun font-set-face-background (&optional face color &rest args)
1090 (interactive) 1089 (interactive)
1091 (condition-case nil 1090 (condition-case nil
1092 (cond 1091 (cond
1093 ((font-rgb-color-p color) 1092 ((or (font-rgb-color-p color)
1093 (string-match "^#[0-9a-fA-F]+$" color))
1094 (apply 'set-face-background face 1094 (apply 'set-face-background face
1095 (font-normalize-color color) args)) 1095 (font-normalize-color color) args))
1096 (t 1096 (t
1097 (apply 'set-face-background face color args))) 1097 (apply 'set-face-background face color args)))
1098 (error nil))) 1098 (error nil)))
1099 1099
1100 (defun font-set-face-foreground (&optional face color &rest args) 1100 (defun font-set-face-foreground (&optional face color &rest args)
1101 (interactive) 1101 (interactive)
1102 (condition-case nil 1102 (condition-case nil
1103 (cond 1103 (cond
1104 ((font-rgb-color-p color) 1104 ((or (font-rgb-color-p color)
1105 (string-match "^#[0-9a-fA-F]+$" color))
1105 (apply 'set-face-foreground face (font-normalize-color color) args)) 1106 (apply 'set-face-foreground face (font-normalize-color color) args))
1106 (t 1107 (t
1107 (apply 'set-face-foreground face color args))) 1108 (apply 'set-face-foreground face color args)))
1108 (error nil))) 1109 (error nil)))
1109 1110