Mercurial > hg > xemacs-beta

comparison lisp/x-faces.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 6719134a07c2
children de805c49cfc1
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
1 ;;; x-faces.el --- X-specific face frobnication, aka black magic. 1 ;;; x-faces.el --- X-specific face frobnication, aka black magic.
2 2
3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996 Ben Wing. 4 ;; Copyright (C) 1995, 1996 Ben Wing.
5 5
6 ;; Author: Jamie Zawinski <jwz@netscape.com> 6 ;; Author: Jamie Zawinski <jwz@jwz.org>
7 ;; Maintainer: XEmacs Development Team 7 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: extensions, internal, dumped 8 ;; Keywords: extensions, internal, dumped
9 9
10 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
11 11
174 (defun x-make-font-unbold (font &optional device) 174 (defun x-make-font-unbold (font &optional device)
175 "Given an X font specification, this attempts to make a non-bold font. 175 "Given an X font specification, this attempts to make a non-bold font.
176 If it fails, it returns nil." 176 If it fails, it returns nil."
177 (try-font-name (x-frob-font-weight font "medium") device)) 177 (try-font-name (x-frob-font-weight font "medium") device))
178 178
179 (defcustom *try-oblique-before-italic-fonts* nil 179 (defcustom try-oblique-before-italic-fonts nil
180 "*If nil, italic fonts are searched before oblique fonts. 180 "*If nil, italic fonts are searched before oblique fonts.
181 If non-nil, oblique fonts are tried before italic fonts. This is mostly 181 If non-nil, oblique fonts are tried before italic fonts. This is mostly
182 applicable to adobe-courier fonts" 182 applicable to adobe-courier fonts"
183 :type 'boolean 183 :type 'boolean
184 :tag "Try Oblique Before Italic Fonts"
185 :group 'x) 184 :group 'x)
185 (define-obsolete-variable-alias '*try-oblique-before-italic-fonts*
186 'try-oblique-before-italic-fonts)
186 187
187 (defun x-make-font-italic (font &optional device) 188 (defun x-make-font-italic (font &optional device)
188 "Given an X font specification, this attempts to make an `italic' font. 189 "Given an X font specification, this attempts to make an `italic' font.
189 If it fails, it returns nil." 190 If it fails, it returns nil."
190 (if *try-oblique-before-italic-fonts* 191 (if try-oblique-before-italic-fonts
191 (or (try-font-name (x-frob-font-slant font "o") device) 192 (or (try-font-name (x-frob-font-slant font "o") device)
192 (try-font-name (x-frob-font-slant font "i") device)) 193 (try-font-name (x-frob-font-slant font "i") device))
193 (or (try-font-name (x-frob-font-slant font "i") device) 194 (or (try-font-name (x-frob-font-slant font "i") device)
194 (try-font-name (x-frob-font-slant font "o") device)))) 195 (try-font-name (x-frob-font-slant font "o") device))))
195 196
200 201
201 (defun x-make-font-bold-italic (font &optional device) 202 (defun x-make-font-bold-italic (font &optional device)
202 "Given an X font specification, this attempts to make a `bold-italic' font. 203 "Given an X font specification, this attempts to make a `bold-italic' font.
203 If it fails, it returns nil." 204 If it fails, it returns nil."
204 ;; This is haired up to avoid loading the "intermediate" fonts. 205 ;; This is haired up to avoid loading the "intermediate" fonts.
205 (or (try-font-name 206 (if *try-oblique-before-italic-fonts*
206 (x-frob-font-slant (x-frob-font-weight font "bold") "i") device) 207 (or (try-font-name
207 (try-font-name 208 (x-frob-font-slant (x-frob-font-weight font "bold") "o") device)
208 (x-frob-font-slant (x-frob-font-weight font "bold") "o") device) 209 (try-font-name
209 (try-font-name 210 (x-frob-font-slant (x-frob-font-weight font "bold") "i") device)
210 (x-frob-font-slant (x-frob-font-weight font "black") "i") device) 211 (try-font-name
211 (try-font-name 212 (x-frob-font-slant (x-frob-font-weight font "black") "o") device)
212 (x-frob-font-slant (x-frob-font-weight font "black") "o") device) 213 (try-font-name
213 (try-font-name 214 (x-frob-font-slant (x-frob-font-weight font "black") "i") device)
214 (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device) 215 (try-font-name
215 (try-font-name 216 (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device)
216 (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device))) 217 (try-font-name
218 (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device))
219 (or (try-font-name
220 (x-frob-font-slant (x-frob-font-weight font "bold") "i") device)
221 (try-font-name
222 (x-frob-font-slant (x-frob-font-weight font "bold") "o") device)
223 (try-font-name
224 (x-frob-font-slant (x-frob-font-weight font "black") "i") device)
225 (try-font-name
226 (x-frob-font-slant (x-frob-font-weight font "black") "o") device)
227 (try-font-name
228 (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device)
229 (try-font-name
230 (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device))))
217 231
218 (defun x-font-size (font) 232 (defun x-font-size (font)
219 "Return the nominal size of the given font. 233 "Return the nominal size of the given font.
220 This is done by parsing its name, so it's likely to lose. 234 This is done by parsing its name, so it's likely to lose.
221 X fonts can be specified (by the user) in either pixels or 10ths of points, 235 X fonts can be specified (by the user) in either pixels or 10ths of points,