Mercurial > hg > xemacs-beta
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 |