Mercurial > hg > xemacs-beta

comparison lisp/w3/font.el @ 189:489f57a838ef r20-3b21

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b21
author cvs
date Mon, 13 Aug 2007 09:57:07 +0200
parents 6608ceec7cf8
children
comparison
equal deleted inserted replaced
188:e29a8e7498d9 189:489f57a838ef
1 ;;; font.el --- New font model 1 ;;; font.el --- New font model
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/04/24 13:55:44 3 ;; Created: 1997/09/05 15:44:37
4 ;; Version: 1.51 4 ;; Version: 1.52
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.
45 (` (defvar (, var) (, value) (, doc)))))) 45 (` (defvar (, var) (, value) (, doc))))))
46 46
47 (if (not (fboundp 'try-font-name)) 47 (if (not (fboundp 'try-font-name))
48 (defun try-font-name (fontname &rest args) 48 (defun try-font-name (fontname &rest args)
49 (case window-system 49 (case window-system
50 ((x win32 pm) (car-safe (x-list-fonts fontname))) 50 ((x win32 w32 pm) (car-safe (x-list-fonts fontname)))
51 (ns (car-safe (ns-list-fonts fontname))) 51 (ns (car-safe (ns-list-fonts fontname)))
52 (otherwise nil)))) 52 (otherwise nil))))
53 53
54 (if (not (fboundp 'facep)) 54 (if (not (fboundp 'facep))
55 (defun facep (face) 55 (defun facep (face)
99 99
100 (defconst font-window-system-mappings 100 (defconst font-window-system-mappings
101 '((x . (x-font-create-name x-font-create-object)) 101 '((x . (x-font-create-name x-font-create-object))
102 (ns . (ns-font-create-name ns-font-create-object)) 102 (ns . (ns-font-create-name ns-font-create-object))
103 (win32 . (x-font-create-name x-font-create-object)) 103 (win32 . (x-font-create-name x-font-create-object))
104 (w32 . (x-font-create-name x-font-create-object))
104 (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME 105 (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME
105 (tty . (tty-font-create-plist tty-font-create-object))) 106 (tty . (tty-font-create-plist tty-font-create-object)))
106 "An assoc list mapping device types to the function used to create 107 "An assoc list mapping device types to the function used to create
107 a font name from a font structure.") 108 a font name from a font structure.")
108 109
1142 (win32 1143 (win32
1143 (let* ((rgb (font-color-rgb-components color)) 1144 (let* ((rgb (font-color-rgb-components color))
1144 (color (apply 'format "#%02x%02x%02x" rgb))) 1145 (color (apply 'format "#%02x%02x%02x" rgb)))
1145 (win32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) 1146 (win32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color)
1146 color)) 1147 color))
1148 (w32
1149 (let* ((rgb (font-color-rgb-components color))
1150 (color (apply 'format "#%02x%02x%02x" rgb)))
1151 (w32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color)
1152 color))
1147 (tty 1153 (tty
1148 (apply 'font-tty-find-closest-color (font-color-rgb-components color))) 1154 (apply 'font-tty-find-closest-color (font-color-rgb-components color)))
1149 (ns 1155 (ns
1150 (let ((vals (mapcar (function (lambda (x) (>> x 8))) 1156 (let ((vals (mapcar (function (lambda (x) (>> x 8)))
1151 (font-color-rgb-components color)))) 1157 (font-color-rgb-components color))))