Mercurial > hg > xemacs-beta

comparison lisp/font.el @ 5473:ac37a5f7e5be

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Thu, 17 Mar 2011 23:42:59 +0100
parents b9167d522a9a f00192e1cd49
children 248176c74e6b
comparison
equal deleted inserted replaced
5472:e79980ee5efe 5473:ac37a5f7e5be
424 424
425 (defun font-combine-fonts (&rest args) 425 (defun font-combine-fonts (&rest args)
426 (cond 426 (cond
427 ((null args) 427 ((null args)
428 (error "Wrong number of arguments to font-combine-fonts")) 428 (error "Wrong number of arguments to font-combine-fonts"))
429 ((= (length args) 1) 429 ((eql (length args) 1)
430 (car args)) 430 (car args))
431 (t 431 (t
432 (let ((retval (font-combine-fonts-internal (nth 0 args) (nth 1 args)))) 432 (let ((retval (font-combine-fonts-internal (nth 0 args) (nth 1 args))))
433 (setq args (cdr (cdr args))) 433 (setq args (cdr (cdr args)))
434 (while args 434 (while args
986 ;;; can deal with either syntax. 986 ;;; can deal with either syntax.
987 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 987 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
988 ;;; ###autoload 988 ;;; ###autoload
989 (defun font-set-face-font (&optional face font &rest args) 989 (defun font-set-face-font (&optional face font &rest args)
990 (cond 990 (cond
991 ((and (vectorp font) (= (length font) 12)) 991 ((and (vectorp font) (eql (length font) 12))
992 (let ((font-name (font-create-name font))) 992 (let ((font-name (font-create-name font)))
993 (set-face-property face 'font-specification font) 993 (set-face-property face 'font-specification font)
994 (cond 994 (cond
995 ((null font-name) ; No matching font! 995 ((null font-name) ; No matching font!
996 nil) 996 nil)
1173 #FEFEFE and rgb:fe/fe/fe style specifications are parsed." 1173 #FEFEFE and rgb:fe/fe/fe style specifications are parsed."
1174 (let ((case-fold-search t) 1174 (let ((case-fold-search t)
1175 r g b str) 1175 r g b str)
1176 (cond ((string-match "^#[0-9a-f]+$" color) 1176 (cond ((string-match "^#[0-9a-f]+$" color)
1177 (cond 1177 (cond
1178 ((= (length color) 4) 1178 ((eql (length color) 4)
1179 (setq r (font-hex-string-to-number (substring color 1 2)) 1179 (setq r (font-hex-string-to-number (substring color 1 2))
1180 g (font-hex-string-to-number (substring color 2 3)) 1180 g (font-hex-string-to-number (substring color 2 3))
1181 b (font-hex-string-to-number (substring color 3 4)) 1181 b (font-hex-string-to-number (substring color 3 4))
1182 r (* r 4096) 1182 r (* r 4096)
1183 g (* g 4096) 1183 g (* g 4096)
1184 b (* b 4096))) 1184 b (* b 4096)))
1185 ((= (length color) 7) 1185 ((eql (length color) 7)
1186 (setq r (font-hex-string-to-number (substring color 1 3)) 1186 (setq r (font-hex-string-to-number (substring color 1 3))
1187 g (font-hex-string-to-number (substring color 3 5)) 1187 g (font-hex-string-to-number (substring color 3 5))
1188 b (font-hex-string-to-number (substring color 5 7)) 1188 b (font-hex-string-to-number (substring color 5 7))
1189 r (* r 256) 1189 r (* r 256)
1190 g (* g 256) 1190 g (* g 256)
1191 b (* b 256))) 1191 b (* b 256)))
1192 ((= (length color) 10) 1192 ((eql (length color) 10)
1193 (setq r (font-hex-string-to-number (substring color 1 4)) 1193 (setq r (font-hex-string-to-number (substring color 1 4))
1194 g (font-hex-string-to-number (substring color 4 7)) 1194 g (font-hex-string-to-number (substring color 4 7))
1195 b (font-hex-string-to-number (substring color 7 10)) 1195 b (font-hex-string-to-number (substring color 7 10))
1196 r (* r 16) 1196 r (* r 16)
1197 g (* g 16) 1197 g (* g 16)
1198 b (* b 16))) 1198 b (* b 16)))
1199 ((= (length color) 13) 1199 ((eql (length color) 13)
1200 (setq r (font-hex-string-to-number (substring color 1 5)) 1200 (setq r (font-hex-string-to-number (substring color 1 5))
1201 g (font-hex-string-to-number (substring color 5 9)) 1201 g (font-hex-string-to-number (substring color 5 9))
1202 b (font-hex-string-to-number (substring color 9 13)))) 1202 b (font-hex-string-to-number (substring color 9 13))))
1203 (t 1203 (t
1204 (font-warn 'color (format "Invalid RGB color specification: %s" 1204 (font-warn 'color (format "Invalid RGB color specification: %s"
1229 b 0))) 1229 b 0)))
1230 (list r g b) )) 1230 (list r g b) ))
1231 1231
1232 (defun font-rgb-color-p (obj) 1232 (defun font-rgb-color-p (obj)
1233 (or (and (vectorp obj) 1233 (or (and (vectorp obj)
1234 (= (length obj) 4) 1234 (eql (length obj) 4)
1235 (eq (aref obj 0) 'rgb)))) 1235 (eq (aref obj 0) 'rgb))))
1236 1236
1237 (defun font-rgb-color-red (obj) (aref obj 1)) 1237 (defun font-rgb-color-red (obj) (aref obj 1))
1238 (defun font-rgb-color-green (obj) (aref obj 2)) 1238 (defun font-rgb-color-green (obj) (aref obj 2))
1239 (defun font-rgb-color-blue (obj) (aref obj 3)) 1239 (defun font-rgb-color-blue (obj) (aref obj 3))
1253 (* 65535 (aref color 2)))) 1253 (* 65535 (aref color 2))))
1254 ((font-rgb-color-p color) 1254 ((font-rgb-color-p color)
1255 (list (font-rgb-color-red color) 1255 (list (font-rgb-color-red color)
1256 (font-rgb-color-green color) 1256 (font-rgb-color-green color)
1257 (font-rgb-color-blue color))) 1257 (font-rgb-color-blue color)))
1258 ((and (vectorp color) (= 3 (length color))) 1258 ((and (vectorp color) (eql 3 (length color)))
1259 (list (aref color 0) (aref color 1) (aref color 2))) 1259 (list (aref color 0) (aref color 1) (aref color 2)))
1260 ((and (listp color) (= 3 (length color)) (floatp (car color))) 1260 ((and (listp color) (eql 3 (length color)) (floatp (car color)))
1261 (mapcar #'(lambda (x) (* x 65535)) color)) 1261 (mapcar #'(lambda (x) (* x 65535)) color))
1262 ((and (listp color) (= 3 (length color))) 1262 ((and (listp color) (eql 3 (length color)))
1263 color) 1263 color)
1264 ((or (string-match "^#" color) 1264 ((or (string-match "^#" color)
1265 (string-match "^rgb:" color)) 1265 (string-match "^rgb:" color))
1266 (font-parse-rgb-components color)) 1266 (font-parse-rgb-components color))
1267 ((string-match "\\([0-9.]+\\)[ \t]\\([0-9.]+\\)[ \t]\\([0-9.]+\\)" 1267 ((string-match "\\([0-9.]+\\)[ \t]\\([0-9.]+\\)[ \t]\\([0-9.]+\\)"