annotate lisp/x-faces.el @ 3063:d30cd499e445

[xemacs-hg @ 2005-11-13 10:48:01 by ben] further error-checking, etc. alloc.c, lrecord.h: Move around the handling of setting of lheader->uid so it's in set_lheader_implementation() -- that way, even non-MC-ALLOC builds get useful uid's in their bare lrecords. Redo related code for strings so the non-ascii count that is stored in the uid isn't hosed. events.c: Save and restore the uid around event zeroing/deadbeefing. lisp.h: Set the correct value of MAX_STRING_ASCII_BEGIN under MC_ALLOC. lisp.h: rearrange the basic code handling ints and chars. basic int stuff goes first, followed by basic char stuff, followed in turn by stuff that mixes ints and chars. this is required since some basic defn's have become inline functions. XCHAR and CHARP have additional error-checking in that they check to make sure that the value in question is not just a character but a valid character (i.e. its numeric value is valid). print.c: debug_p4 now has a useful UID in all cases and uses it; but it also prints the raw header address (previously, you just got one of them). text.h: some basic char defn's that belonged in lisp.h have been moved there. valid_ichar_p() is moved too since the inline functions need it.
author ben
date Sun, 13 Nov 2005 10:48:04 +0000
parents 2f2d12f4f93a
children ad2f4ae9895b
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; x-faces.el --- X-specific face frobnication, aka black magic.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
2527
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
4 ;; Copyright (C) 1995, 1996, 2002, 2004 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Author: Jamie Zawinski <jwz@jwz.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: extensions, internal, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Synched up with: Not synched.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; This file is dumped with XEmacs (when X support is compiled in).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; Modified by: Chuck Thompson
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; Modified by: Ben Wing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; Modified by: Martin Buchholz
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; This file does the magic to parse X font names, and make sure that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; default and modeline attributes of new frames are specified enough.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; The resource-manager syntax for faces is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
2703
2f2d12f4f93a [xemacs-hg @ 2005-03-31 11:28:41 by aidan]
aidan
parents: 2527
diff changeset
42 ;; XEmacs.bold.attributeFont: font-name
2f2d12f4f93a [xemacs-hg @ 2005-03-31 11:28:41 by aidan]
aidan
parents: 2527
diff changeset
43 ;; XEmacs.bold.attributeForeground: fg
2f2d12f4f93a [xemacs-hg @ 2005-03-31 11:28:41 by aidan]
aidan
parents: 2527
diff changeset
44 ;; XEmacs.bold.attributeBackground: bg
2f2d12f4f93a [xemacs-hg @ 2005-03-31 11:28:41 by aidan]
aidan
parents: 2527
diff changeset
45 ;; XEmacs.bold.attributeBackgroundPixmap: file
2f2d12f4f93a [xemacs-hg @ 2005-03-31 11:28:41 by aidan]
aidan
parents: 2527
diff changeset
46 ;; XEmacs.bold.attributeUnderline: true/false
2f2d12f4f93a [xemacs-hg @ 2005-03-31 11:28:41 by aidan]
aidan
parents: 2527
diff changeset
47 ;; XEmacs.bold.attributeStrikethru: true/false
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;; You can specify the properties of a face on a per-frame basis. For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; example, to have the "isearch" face use a red foreground on frames
2703
2f2d12f4f93a [xemacs-hg @ 2005-03-31 11:28:41 by aidan]
aidan
parents: 2527
diff changeset
51 ;; named "XEmacs" (the default) but use a blue foreground on frames that
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;; you create named "debugger", you could do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
2703
2f2d12f4f93a [xemacs-hg @ 2005-03-31 11:28:41 by aidan]
aidan
parents: 2527
diff changeset
54 ;; XEmacs*XEmacs.isearch.attributeForeground: red
2f2d12f4f93a [xemacs-hg @ 2005-03-31 11:28:41 by aidan]
aidan
parents: 2527
diff changeset
55 ;; XEmacs*debugger.isearch.attributeForeground: blue
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; Generally things that make faces won't set any of the face attributes if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; you have already given them values via the resource database. You can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; also change this stuff from your .emacs file, by using the functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;; set-face-foreground, set-face-font, etc. See the code in this file, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;; in faces.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
65 (globally-declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
66 '(x-get-resource-and-maybe-bogosity-check
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
67 x-get-resource x-init-pointer-shape))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
68
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (defconst x-font-regexp nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (defconst x-font-regexp-head nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (defconst x-font-regexp-head-2 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (defconst x-font-regexp-weight nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (defconst x-font-regexp-slant nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 (defconst x-font-regexp-pixel nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (defconst x-font-regexp-point nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (defconst x-font-regexp-foundry-and-family nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (defconst x-font-regexp-registry-and-encoding nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (defconst x-font-regexp-spacing nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;;; Regexps matching font names in "Host Portable Character Representation."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (let ((- "[-?]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (foundry "[^-]*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (family "[^-]*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 (weight "\\(bold\\|demibold\\|medium\\|black\\)") ; 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (weight\? "\\([^-]*\\)") ; 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (slant "\\([ior]\\)") ; 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ; (slant\? "\\([ior?*]?\\)") ; 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (slant\? "\\([^-]?\\)") ; 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (swidth "\\([^-]*\\)") ; 3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 ; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (adstyle "\\([^-]*\\)") ; 4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (pixelsize "\\(\\*\\|[0-9]+\\)") ; 5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (pointsize "\\(\\*\\|0\\|[0-9][0-9]+\\)") ; 6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 ; (resx "\\(\\*\\|[0-9][0-9]+\\)") ; 7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 ; (resy "\\(\\*\\|[0-9][0-9]+\\)") ; 8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (resx "\\([*0]\\|[0-9][0-9]+\\)") ; 7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (resy "\\([*0]\\|[0-9][0-9]+\\)") ; 8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (spacing "[cmp?*]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (avgwidth "\\(\\*\\|[0-9]+\\)") ; 9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (registry "[^-]*") ; some fonts have omitted registries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 ; (encoding ".+") ; note that encoding may contain "-"...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (encoding "[^-]+") ; false!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (setq x-font-regexp
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
108 (concat "\\`\\*?[-?*]"
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
109 foundry - family - weight\? - slant\? - swidth - adstyle -
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
110 pixelsize - pointsize - resx - resy - spacing - avgwidth -
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
111 registry - encoding "\\'"
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
112 ))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (setq x-font-regexp-head
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
114 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
115 "\\([-*?]\\|\\'\\)"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (setq x-font-regexp-head-2
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
117 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
118 - swidth - adstyle - pixelsize - pointsize
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
119 "\\([-*?]\\|\\'\\)"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
120 (setq x-font-regexp-slant (concat - slant -))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
121 (setq x-font-regexp-weight (concat - weight -))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 ;; if we can't match any of the more specific regexps (unfortunate) then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 ;; look for digits; assume 2+ digits is 10ths of points, and 1-2 digits
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 ;; is pixels. Bogus as hell.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
125 (setq x-font-regexp-pixel "[-?*]\\([0-9][0-9]?\\)[-?*]")
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
126 (setq x-font-regexp-point "[-?*]\\([0-9][0-9]+\\)[-?*]")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 ;; the following two are used by x-font-menu.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 (setq x-font-regexp-foundry-and-family
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
129 (concat "\\`[-?*]" foundry - "\\(" family "\\)" -))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (setq x-font-regexp-registry-and-encoding
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
131 (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (setq x-font-regexp-spacing
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
133 (concat - "\\(" spacing "\\)" - avgwidth
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
134 - registry - encoding "\\'"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 ;; A "loser font" is something like "8x13" -> "8x13bold".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 ;; These are supported only through extreme generosity.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
139 (defconst x-loser-font-regexp "\\`[0-9]+x[0-9]+\\'")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (defun x-frob-font-weight (font which)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (if (font-instance-p font) (setq font (font-instance-name font)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 (cond ((null font) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 ((or (string-match x-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (string-match x-font-regexp-head font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (string-match x-font-regexp-weight font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (concat (substring font 0 (match-beginning 1)) which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 (substring font (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 ((string-match x-loser-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (concat font which))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (defun x-frob-font-slant (font which)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (if (font-instance-p font) (setq font (font-instance-name font)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (cond ((null font) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 ((or (string-match x-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (string-match x-font-regexp-head font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (concat (substring font 0 (match-beginning 2)) which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (substring font (match-end 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 ((string-match x-font-regexp-slant font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (concat (substring font 0 (match-beginning 1)) which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (substring font (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 ((string-match x-loser-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (concat font which))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (defun x-make-font-bold (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 "Given an X font specification, this attempts to make a `bold' font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 If it fails, it returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 ;; Certain Type1 fonts know "bold" as "black"...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (or (try-font-name (x-frob-font-weight font "bold") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (try-font-name (x-frob-font-weight font "black") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (try-font-name (x-frob-font-weight font "demibold") device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (defun x-make-font-unbold (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 "Given an X font specification, this attempts to make a non-bold font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 If it fails, it returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 (try-font-name (x-frob-font-weight font "medium") device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (defcustom try-oblique-before-italic-fonts nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 "*If nil, italic fonts are searched before oblique fonts.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 If non-nil, oblique fonts are tried before italic fonts. This is mostly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 applicable to adobe-courier fonts"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 :group 'x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (define-obsolete-variable-alias '*try-oblique-before-italic-fonts*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 'try-oblique-before-italic-fonts)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (defun x-make-font-italic (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 "Given an X font specification, this attempts to make an `italic' font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 If it fails, it returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (if try-oblique-before-italic-fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (or (try-font-name (x-frob-font-slant font "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (try-font-name (x-frob-font-slant font "i") device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (or (try-font-name (x-frob-font-slant font "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (try-font-name (x-frob-font-slant font "o") device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (defun x-make-font-unitalic (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 "Given an X font specification, this attempts to make a non-italic font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 If it fails, it returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (try-font-name (x-frob-font-slant font "r") device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (defun x-make-font-bold-italic (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 "Given an X font specification, this attempts to make a `bold-italic' font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 If it fails, it returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 ;; This is haired up to avoid loading the "intermediate" fonts.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
207 (if try-oblique-before-italic-fonts
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 (or (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 (x-frob-font-slant (x-frob-font-weight font "bold") "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (x-frob-font-slant (x-frob-font-weight font "bold") "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (x-frob-font-slant (x-frob-font-weight font "black") "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (x-frob-font-slant (x-frob-font-weight font "black") "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (or (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (x-frob-font-slant (x-frob-font-weight font "bold") "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 (x-frob-font-slant (x-frob-font-weight font "bold") "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 (x-frob-font-slant (x-frob-font-weight font "black") "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (x-frob-font-slant (x-frob-font-weight font "black") "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (defun x-font-size (font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 "Return the nominal size of the given font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 This is done by parsing its name, so it's likely to lose.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 X fonts can be specified (by the user) in either pixels or 10ths of points,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 and this returns the first one it finds, so you have to decide which units
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 the returned value is measured in yourself..."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (if (font-instance-p font) (setq font (font-instance-name font)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (cond ((or (string-match x-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (string-match x-font-regexp-head-2 font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (string-to-int (substring font (match-beginning 6) (match-end 6))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 ((or (string-match x-font-regexp-pixel font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (string-match x-font-regexp-point font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (string-to-int (substring font (match-beginning 1) (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 ;; Given a font name, this function returns a list describing all fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 ;; of all sizes that otherwise match the given font spec. Each element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 ;; in the list is a list of three items: the pixel size of the font,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 ;; the point size (in 1/10ths of a point) of the font, and the fully-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 ;; qualified font name. The first two values may be zero; this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 ;; refers to a scalable font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (defun x-available-font-sizes (font device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (if (font-instance-p font) (setq font (font-instance-name font)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (cond ((string-match x-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 ;; turn pixelsize, pointsize, and avgwidth into wildcards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (setq font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (concat (substring font 0 (match-beginning 5)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (substring font (match-end 5) (match-beginning 6)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (substring font (match-end 6) (match-beginning 9)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (substring font (match-end 9) (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 ((string-match x-font-regexp-head-2 font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 ;; turn pixelsize and pointsize into wildcards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (setq font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 (concat (substring font 0 (match-beginning 5)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 (substring font (match-end 5) (match-beginning 6)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 (substring font (match-end 6) (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ((string-match "[-?*]\\([0-9]+\\)[-?*]" font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 ;; Turn the first integer we match into a wildcard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 ;; This is pretty dubious...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (setq font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (concat (substring font 0 (match-beginning 1)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (substring font (match-end 1) (match-end 0))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (sort
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (delq nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (mapcar (function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (lambda (name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (and (string-match x-font-regexp name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (string-to-int (substring name (match-beginning 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (match-end 5)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (string-to-int (substring name (match-beginning 6)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (match-end 6)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 name))))
2527
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
287 (font-list font device)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (function (lambda (x y) (if (= (nth 1 x) (nth 1 y))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (< (nth 0 x) (nth 0 y))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (< (nth 1 x) (nth 1 y)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 ;; Given a font name, this attempts to construct a valid font name for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 ;; DEVICE whose size is the next smaller (if UP-P is nil) or larger
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 ;; (if UP-P is t) size and whose other characteristics are the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 ;; as the given font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (defun x-frob-font-size (font up-p device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (if (stringp font) (setq font (make-font-instance font device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (if (font-instance-p font) (setq font (font-instance-truename font)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (let ((available (and font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (x-available-font-sizes font device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 ((null available) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 ((or (= 0 (nth 0 (car available)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (= 0 (nth 1 (car available))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 ;; R5 scalable fonts: change size by 1 point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 ;; If they're scalable the first font will have pixel or point = 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 ;; Sometimes one is 0 and the other isn't (if it's a bitmap font that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 ;; can be scaled), sometimes both are (if it's a true outline font).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (let ((name (nth 2 (car available)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 old-size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (or (string-match x-font-regexp font) (error "can't parse %S" font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (setq old-size (string-to-int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (substring font (match-beginning 6) (match-end 6))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (or (> old-size 0) (error "font truename has 0 pointsize?"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (or (string-match x-font-regexp name) (error "can't parse %S" name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 ;; turn pixelsize into a wildcard, and make pointsize be +/- 10,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 ;; which is +/- 1 point. All other fields stay the same as they
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 ;; were in the "template" font returned by x-available-font-sizes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 ;; #### But this might return the same font: for example, if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 ;; truename of "-*-courier-medium-r-normal--*-230-75-75-m-0-*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 ;; is "...-240-..." (instead of 230) then this loses, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 ;; the 230 that was passed in as an arg got turned into 240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 ;; by the call to font-instance-truename; then we decrement that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 ;; by 10 and return the result which is the same. I think the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 ;; way to fix this is to make this be a loop that keeps trying
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 ;; progressively larger pointsize deltas until it finds one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 ;; whose truename differs. Have to be careful to avoid infinite
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 ;; loops at the upper end...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (concat (substring name 0 (match-beginning 5)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 (substring name (match-end 5) (match-beginning 6))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 (int-to-string (+ old-size (if up-p 10 -10)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (substring name (match-end 6) (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 ;; non-scalable fonts: take the next available size.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (let ((rest available)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (last nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (while rest
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 502
diff changeset
342 (cond ((and (not up-p) (equalp font (nth 2 (car rest))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (setq result last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 rest nil))
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 502
diff changeset
345 ((and up-p (equalp font (and last (nth 2 last))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 (setq result (car rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 rest nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (setq last (car rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (setq rest (cdr rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (nth 2 result))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (defun x-find-smaller-font (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 "Load a new, slightly smaller version of the given font (or font name).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 Returns the font if it succeeds, nil otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 If scalable fonts are available, this returns a font which is 1 point smaller.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 Otherwise, it returns the next smaller version of this font that is defined."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (x-frob-font-size font nil device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (defun x-find-larger-font (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 "Load a new, slightly larger version of the given font (or font name).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 Returns the font if it succeeds, nil otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 If scalable fonts are available, this returns a font which is 1 point larger.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 Otherwise, it returns the next larger version of this font that is defined."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (x-frob-font-size font t device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 (defalias 'x-make-face-bold 'make-face-bold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (defalias 'x-make-face-italic 'make-face-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (defalias 'x-make-face-bold-italic 'make-face-bold-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (defalias 'x-make-face-unbold 'make-face-unbold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (defalias 'x-make-face-unitalic 'make-face-unitalic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 (make-obsolete 'x-make-face-bold 'make-face-bold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (make-obsolete 'x-make-face-italic 'make-face-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (make-obsolete 'x-make-face-bold-italic 'make-face-bold-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (make-obsolete 'x-make-face-unbold 'make-face-unbold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (make-obsolete 'x-make-face-unitalic 'make-face-unitalic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378
2527
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
379
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
380 ;; #### - wrong place for this variable? Exactly. We probably want
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
381 ;; `color-list' to be a console method, so `tty-color-list' becomes
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
382 ;; obsolete, and `read-color-completion-table' conses (mapcar #'list
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
383 ;; (color-list)), optionally caching the results.
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
384
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
385 ;; Ben wanted all of the possibilities from the `configure' script used
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
386 ;; here, but I think this is way too many. I already trimmed the R4 variants
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
387 ;; and a few obvious losers from the list. --Stig
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
388 (defvar x-library-search-path '("/usr/X11R6/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
389 "/usr/X11R5/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
390 "/usr/lib/X11R6/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
391 "/usr/lib/X11R5/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
392 "/usr/local/X11R6/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
393 "/usr/local/X11R5/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
394 "/usr/local/lib/X11R6/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
395 "/usr/local/lib/X11R5/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
396 "/usr/X11/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
397 "/usr/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
398 "/usr/local/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
399 "/usr/X386/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
400 "/usr/x386/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
401 "/usr/XFree86/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
402 "/usr/unsupported/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
403 "/usr/athena/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
404 "/usr/local/x11r5/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
405 "/usr/lpp/Xamples/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
406 "/usr/openwin/lib/X11/"
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
407 "/usr/openwin/share/lib/X11/")
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
408 "Search path used by `x-color-list-internal' to find rgb.txt.")
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
409
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
410 (defvar x-color-list-internal-cache)
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
411
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
412 (defun x-color-list-internal ()
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
413 (if (boundp 'x-color-list-internal-cache)
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
414 x-color-list-internal-cache
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
415 (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
416 clist color p)
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
417 (if (not rgb-file)
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
418 ;; prevents multiple searches for rgb.txt if we can't find it
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
419 (setq x-color-list-internal-cache nil)
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
420 (with-current-buffer (get-buffer-create " *colors*")
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
421 (reset-buffer (current-buffer))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
422 (insert-file-contents rgb-file)
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
423 (while (not (eobp))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
424 ;; skip over comments
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
425 (while (looking-at "^!")
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
426 (end-of-line)
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
427 (forward-char 1))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
428 (skip-chars-forward "0-9 \t")
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
429 (setq p (point))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
430 (end-of-line)
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
431 (setq color (buffer-substring p (point))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
432 clist (cons (list color) clist))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
433 ;; Ugh. If we want to be able to complete the lowercase form
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
434 ;; of the color name, we need to add it twice! Yuck.
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
435 (let ((dcase (downcase color)))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
436 (or (string= dcase color)
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
437 (push (list dcase) clist)))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
438 (forward-char 1))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
439 (kill-buffer (current-buffer))))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
440 (setq x-color-list-internal-cache clist)
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
441 x-color-list-internal-cache)))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
442
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 872
diff changeset
443
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 ;;; internal routines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 ;;; x-init-face-from-resources is responsible for initializing a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 ;;; newly-created face from the resource database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 ;;; When a new frame is created, it is called from `x-init-frame-faces'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 ;;; called from `init-frame-faces' called from init_frame_faces()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 ;;; from Fmake_frame(). In this case it is called once for each existing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 ;;; face, with the newly-created frame as the argument. It then initializes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 ;;; the newly-created faces on that frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 ;;; It's also called from `init-device-faces' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 ;;; `init-global-faces'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 ;;; This had better not signal an error. The frame is in an intermediate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 ;;; state where signalling an error or entering the debugger would likely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 ;;; result in a crash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (defun x-init-face-from-resources (face &optional locale set-anyway)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 ;; These are things like "attributeForeground" instead of simply
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 ;; "foreground" because people tend to do things like "*foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 ;; which would cause all faces to be fully qualified, making faces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 ;; inherit attributes in a non-useful way. So we've made them slightly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 ;; less obvious to specify in order to make them work correctly in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 ;; more random environments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 ;; I think these should be called "face.faceForeground" instead of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 ;; "face.attributeForeground", but they're the way they are for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 ;; hysterical reasons. (jwz)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (let* ((append (if set-anyway nil 'append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 ;; Some faces are initialized before XEmacs is dumped.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 ;; In order for the X resources to be able to override
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 ;; those settings, such initialization always uses the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 ;; `default' tag. We remove all specifier specs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 ;; containing the `default' tag in the locale before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 ;; adding new specs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 (tag-set '(default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 ;; The tag order matters here. The spec removal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 ;; function uses the list cdrs. We want to remove (x
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 ;; default) and (default) specs, not (default x) and (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 ;; specs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 (x-tag-set '(x default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (tty-tag-set '(tty default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (device-class nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (face-sym (face-name face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (name (symbol-name face-sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (fn (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (concat name ".attributeFont")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 "Face.AttributeFont"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 (fg (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 (concat name ".attributeForeground")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 "Face.AttributeForeground"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (bg (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 (concat name ".attributeBackground")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 "Face.AttributeBackground"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 (bgp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (concat name ".attributeBackgroundPixmap")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 "Face.AttributeBackgroundPixmap"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 (ulp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 (concat name ".attributeUnderline")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 "Face.AttributeUnderline"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 (stp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 (concat name ".attributeStrikethru")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 "Face.AttributeStrikethru"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 ;; we still resource for these TTY-only resources so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 ;; you can specify resources for TTY frames/devices. This is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 ;; useful when you start up your XEmacs on an X display and later
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 ;; open some TTY frames.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 (hp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (concat name ".attributeHighlight")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 "Face.AttributeHighlight"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (dp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (concat name ".attributeDim")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 "Face.AttributeDim"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 (bp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (concat name ".attributeBlinking")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 "Face.AttributeBlinking"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (rp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 (concat name ".attributeReverse")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 "Face.AttributeReverse"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (cond ((framep locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (setq device-class (device-class (frame-device locale))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 ((devicep locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (setq device-class (device-class locale))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (setq tag-set (cons device-class tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 x-tag-set (cons device-class x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 tty-tag-set (cons device-class tty-tag-set)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 ;; If this is the default face, then any unspecified properties should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 ;; be defaulted from the global properties. Can't do this for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 ;; frames or devices because then, common resource specs like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 ;; "*Foreground: black" will have unwanted effects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (if (and (or (eq (face-name face) 'default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 (eq (face-name face) 'gui-element))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 (or (null locale) (eq locale 'global)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (or fn (setq fn (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
560 "font" "Font" 'string locale nil 'warn)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (or fg (setq fg (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
562 "foreground" "Foreground" 'string locale nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
563 'warn)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (or bg (setq bg (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
565 "background" "Background" 'string locale nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
566 'warn)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 ;; "*cursorColor: foo" is equivalent to setting the background of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 ;; text-cursor face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (if (and (eq (face-name face) 'text-cursor)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (or (null locale) (eq locale 'global)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 (setq bg (or (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
574 "cursorColor" "CursorColor" 'string locale nil 'warn)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
575 bg)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 ;; #### should issue warnings? I think this should be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 ;; done when the instancing actually happens, but I'm not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 ;; sure how it should actually be dealt with.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 (when fn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 ;; Always use the x-tag-set to remove specs, since we don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 ;; know whether the predumped face was initialized with an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 ;; 'x tag or not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (remove-specifier-specs-matching-tag-set-cdrs (face-font face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 ;; If there's no device class then we're initializing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 ;; globally. This means we should override global
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 ;; defaults for all X device classes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 (remove-specifier (face-font face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 (set-face-font face fn locale 'x append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 ;; Kludge-o-rooni. Set the foreground and background resources for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 ;; X devices only -- otherwise things tend to get all messed up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 ;; if you start up an X frame and then later create a TTY frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (when fg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (remove-specifier-specs-matching-tag-set-cdrs (face-foreground face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 (remove-specifier (face-foreground face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 (set-face-foreground face fg locale 'x append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (when bg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (remove-specifier-specs-matching-tag-set-cdrs (face-background face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (remove-specifier (face-background face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (set-face-background face bg locale 'x append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (when bgp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (remove-specifier-specs-matching-tag-set-cdrs (face-background-pixmap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (remove-specifier (face-background-pixmap face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (set-face-background-pixmap face bgp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 (when ulp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 face 'underline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 (remove-specifier (face-property face 'underline) locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 (set-face-underline-p face ulp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (when stp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 face 'strikethru)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (remove-specifier (face-property face 'strikethru)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 locale tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 (set-face-strikethru-p face stp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 (when hp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 (remove-specifier (face-property face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 locale tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 (set-face-highlight-p face hp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 (when dp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 face 'dim)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 (remove-specifier (face-property face 'dim) locale tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (set-face-dim-p face dp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (when bp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 face 'blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (remove-specifier (face-property face 'blinking) locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (set-face-blinking-p face bp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (when rp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 face 'reverse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 (remove-specifier (face-property face 'reverse) locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 (set-face-reverse-p face rp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 ;; GNU Emacs compatibility. (move to obsolete.el?)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 (defalias 'make-face-x-resource-internal 'x-init-face-from-resources)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 (defun remove-specifier-specs-matching-tag-set-cdrs (specifier locale tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 (while tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (remove-specifier specifier locale tag-set t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (setq tag-set (cdr tag-set))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 ;;; x-init-global-faces is responsible for ensuring that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 ;;; default face has some reasonable fallbacks if nothing else is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 ;;; specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (defun x-init-global-faces ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 (or (face-foreground 'default 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 (set-face-foreground 'default "black" 'global '(x default)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (or (face-background 'default 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 (set-face-background 'default "gray80" 'global '(x default))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 ;;; x-init-device-faces is responsible for initializing default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 ;;; values for faces on a newly created device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (defun x-init-device-faces (device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 ;; If the "default" face didn't have a font specified, try to pick one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 ;;
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
697 ;; (or
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
698 ;; (face-font-instance 'default device)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
699 ;;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
700 ;; [[ No font specified in the resource database; try to cope. ]]
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
701 ;;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
702 ;; NOTE: In reality, this will never happen. The fallbacks will always
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
703 ;; be tried, and the last fallback is "*", which should get any font. No
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
704 ;; need to put the same checks here as in the fallbacks. These comments
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
705 ;; appear to be pre-19.12. --ben
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
707 ;; [[ At first I wanted to do this by just putting a font-spec in the
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
708 ;; fallback resources passed to XtAppInitialize(), but that fails
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
709 ;; if there is an Emacs app-defaults file which doesn't specify a
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
710 ;; font: apparently the fallback resources are not consulted when
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
711 ;; there is an app-defaults file, which seems pretty bogus to me.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
712 ;;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
713 ;; We should also probably try "*xtDefaultFont", but I think that it
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
714 ;; might be legal to specify that as "xtDefaultFont:", that is, at
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
715 ;; top level, instead of "*xtDefaultFont:", that is, applicable to
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
716 ;; every application. `x-get-resource' can't handle that right now.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
717 ;; Anyway, xtDefaultFont is probably variable-width.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
718 ;;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
719 ;; Some who have LucidaTypewriter think it's a better font than Courier,
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
720 ;; but it has the bug that there are no italic and bold italic versions.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
721 ;; We could hair this code up to try and mix-and-match fonts to get a
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
722 ;; full complement, but really, why bother. It's just a default. ]]
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
723 ;;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
724 ;; [[ We default to looking for iso8859 fonts. Using a wildcard for the
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
725 ;; encoding would be bad, because that can cause English speakers to get
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
726 ;; Kanji fonts by default. It is safe to assume that people using a
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
727 ;; language other than English have both set $LANG, and have specified
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
728 ;; their `font' and `fontList' resources. In any event, it's better to
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
729 ;; err on the side of the English speaker in this case because they are
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
730 ;; much less likely to have encountered this problem, and are thus less
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
731 ;; likely to know what to do about it. ]]
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
732
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
733
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 ;; If the "default" face didn't have both colors specified, then pick
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 ;; some, taking into account whether one of the colors was specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 (let ((fg (face-foreground-instance 'default device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 (bg (face-background-instance 'default device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 (if (not (and fg bg))
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 502
diff changeset
741 (if (or (and fg (equalp (color-instance-name fg) "white"))
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 502
diff changeset
742 (and bg (equalp (color-instance-name bg) "black")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 (or fg (set-face-foreground 'default "white" device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 (or bg (set-face-background 'default "black" device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 (or fg (set-face-foreground 'default "white" device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 (or bg (set-face-background 'default "black" device)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 ;; Don't look at reverseVideo now or initialize the modeline. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 ;; is done on a per-frame basis at the appropriate time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 ;; Now let's try to pick some reasonable defaults for a few other faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 ;; This kind of stuff should normally go on the create-frame-hook, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 ;; this way we won't be in danger of the user screwing things up by not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 ;; adding hooks in a safe way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 (x-init-pointer-shape device) ; from x-mouse.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 ;;; This is called from `init-frame-faces', which is called from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 ;;; init_frame_faces() which is called from Fmake_frame(), to perform
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 ;;; any device-specific initialization.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (defun x-init-frame-faces (frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 ;; The faces already got initialized (by init-frame-faces) from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 ;; the resource database or global, non-frame faces. The default,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 ;; bold, bold-italic, and italic faces (plus various other random faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 ;; got set up then. But modeline didn't so that reverseVideo can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 ;; frame-specific.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 ;; If reverseVideo was specified, swap the foreground and background
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 ;; of the default and modeline faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 ;;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
778 (cond ((car (x-get-resource "reverseVideo" "ReverseVideo" 'boolean frame
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
779 nil 'warn))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 ;; First make sure the modeline has fg and bg, inherited from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 ;; current default face - for the case where only one is specified,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 ;; so that invert-face doesn't do something weird.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 (or (face-foreground 'modeline frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 (set-face-foreground 'modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (face-foreground-instance 'default frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 (or (face-background 'modeline frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 (set-face-background 'modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 (face-background-instance 'default frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 ;; Now invert both of them. If they end up looking the same,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 ;; make-frame-initial-faces will invert the modeline again later.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 (invert-face 'default frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 (invert-face 'modeline frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 )))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 ;;; x-faces.el ends here