Commit | Line | Data |
---|---|---|
60370d40 | 1 | ;;; fontset.el --- commands for handling fontset |
4ed46869 | 2 | |
d4877ac1 GM |
3 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
4 | ;; 2005, 2006 Free Software Foundation, Inc. | |
7976eda0 KH |
5 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
6 | ;; 2005, 2006 | |
2fd125a3 KH |
7 | ;; National Institute of Advanced Industrial Science and Technology (AIST) |
8 | ;; Registration Number H14PRO021 | |
4ed46869 KH |
9 | |
10 | ;; Keywords: mule, multilingual, fontset | |
11 | ||
12 | ;; This file is part of GNU Emacs. | |
13 | ||
14 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
15 | ;; it under the terms of the GNU General Public License as published by | |
16 | ;; the Free Software Foundation; either version 2, or (at your option) | |
17 | ;; any later version. | |
18 | ||
19 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
369314dc | 25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
26 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
27 | ;; Boston, MA 02110-1301, USA. | |
4ed46869 | 28 | |
60370d40 PJ |
29 | ;;; Commentary: |
30 | ||
4ed46869 KH |
31 | ;;; Code: |
32 | ||
2ad00186 KH |
33 | ;; Set standard fontname specification of characters in the default |
34 | ;; fontset to find an appropriate font for each charset. This is used | |
35 | ;; to generate a font name for a fontset if the fontset doesn't | |
36 | ;; specify a font name for a specific character. The specification | |
37 | ;; has the form (FAMILY . REGISTRY). FAMILY may be nil, in which | |
38 | ;; case, the family name of default face is used. If REGISTRY | |
39 | ;; contains a character `-', the string before that is embedded in | |
40 | ;; `CHARSET_REGISTRY' field, and the string after that is embedded in | |
41 | ;; `CHARSET_ENCODING' field. If it does not contain `-', the whole | |
42 | ;; string is embedded in `CHARSET_REGISTRY' field, and a wild card | |
43 | ;; character `*' is embedded in `CHARSET_ENCODING' field. The | |
44 | ;; REGISTRY for ASCII characters are predefined as "ISO8859-1". | |
45 | ||
c963bbc2 KH |
46 | (defun setup-default-fontset () |
47 | "Setup the default fontset." | |
a030d0e1 KH |
48 | (dolist (elt |
49 | `((latin-iso8859-1 . (nil . "ISO8859-1")) | |
50 | (latin-iso8859-2 . (nil . "ISO8859-2")) | |
51 | (latin-iso8859-3 . (nil . "ISO8859-3")) | |
52 | (latin-iso8859-4 . (nil . "ISO8859-4")) | |
804ad4c9 KH |
53 | ;; Setting "*" family is for a workaround of the problem |
54 | ;; that a font of wrong size is preferred if the font | |
55 | ;; family matches with a requested one. | |
56 | (thai-tis620 . ("*" . "TIS620")) | |
8d9a9cbd KH |
57 | (greek-iso8859-7 . (nil . "ISO8859-7")) |
58 | (arabic-iso8859-6 . (nil . "ISO8859-6")) | |
59 | (hebrew-iso8859-8 . (nil . "ISO8859-8")) | |
60 | (katakana-jisx0201 . (nil . "JISX0201")) | |
a030d0e1 | 61 | (latin-jisx0201 . (nil . "JISX0201")) |
8d9a9cbd | 62 | (cyrillic-iso8859-5 . (nil . "ISO8859-5")) |
a030d0e1 | 63 | (latin-iso8859-9 . (nil . "ISO8859-9")) |
8d9a9cbd KH |
64 | (japanese-jisx0208-1978 . (nil . "JISX0208.1978")) |
65 | (chinese-gb2312 . (nil . "GB2312.1980")) | |
66 | (japanese-jisx0208 . (nil . "JISX0208.1990")) | |
67 | (korean-ksc5601 . (nil . "KSC5601.1989")) | |
68 | (japanese-jisx0212 . (nil . "JISX0212")) | |
69 | (chinese-cns11643-1 . (nil . "CNS11643.1992-1")) | |
70 | (chinese-cns11643-2 . (nil . "CNS11643.1992-2")) | |
71 | (chinese-cns11643-3 . (nil . "CNS11643.1992-3")) | |
72 | (chinese-cns11643-4 . (nil . "CNS11643.1992-4")) | |
73 | (chinese-cns11643-5 . (nil . "CNS11643.1992-5")) | |
74 | (chinese-cns11643-6 . (nil . "CNS11643.1992-6")) | |
75 | (chinese-cns11643-7 . (nil . "CNS11643.1992-7")) | |
76 | (chinese-big5-1 . (nil . "Big5")) | |
77 | (chinese-big5-2 . (nil . "Big5")) | |
a030d0e1 KH |
78 | (chinese-sisheng . (nil . "sisheng_cwnn")) |
79 | (vietnamese-viscii-lower . (nil . "VISCII1.1")) | |
80 | (vietnamese-viscii-upper . (nil . "VISCII1.1")) | |
8d9a9cbd KH |
81 | (arabic-digit . (nil . "MuleArabic-0")) |
82 | (arabic-1-column . (nil . "MuleArabic-1")) | |
83 | (arabic-2-column . (nil . "MuleArabic-2")) | |
a030d0e1 | 84 | (ipa . (nil . "MuleIPA")) |
8d9a9cbd | 85 | (ethiopic . (nil . "Ethiopic-Unicode")) |
a030d0e1 | 86 | (ascii-right-to-left . (nil . "ISO8859-1")) |
8d9a9cbd KH |
87 | (indian-is13194 . (nil . "IS13194-Devanagari")) |
88 | (indian-2-column . (nil . "MuleIndian-2")) | |
89 | (lao . (nil . "MuleLao-1")) | |
a030d0e1 | 90 | (tibetan . ("proportional" . "MuleTibetan-2")) |
8d9a9cbd | 91 | (tibetan-1-column . (nil . "MuleTibetan-1")) |
a030d0e1 KH |
92 | (latin-iso8859-14 . (nil . "ISO8859-14")) |
93 | (latin-iso8859-15 . (nil . "ISO8859-15")) | |
94 | (mule-unicode-0100-24ff . (nil . "ISO10646-1")) | |
95 | (mule-unicode-2500-33ff . (nil . "ISO10646-1")) | |
96 | (mule-unicode-e000-ffff . (nil . "ISO10646-1")) | |
8d9a9cbd KH |
97 | (japanese-jisx0213-1 . (nil . "JISX0213.2000-1")) |
98 | (japanese-jisx0213-2 . (nil . "JISX0213.2000-2")) | |
a030d0e1 KH |
99 | ;; unicode |
100 | ((,(decode-char 'ucs #x0900) . ,(decode-char 'ucs #x097F)) | |
8d9a9cbd | 101 | . (nil . "ISO10646.indian-1")) |
a030d0e1 KH |
102 | ;; Indian CDAC |
103 | (,(indian-font-char-range 'cdac:dv-ttsurekh) | |
8d9a9cbd | 104 | . (nil . "Devanagari-CDAC")) |
a030d0e1 | 105 | (,(indian-font-char-range 'cdac:sd-ttsurekh) |
8d9a9cbd | 106 | . (nil . "Sanskrit-CDAC")) |
a030d0e1 | 107 | (,(indian-font-char-range 'cdac:bn-ttdurga) |
8d9a9cbd | 108 | . (nil . "Bengali-CDAC")) |
a030d0e1 | 109 | (,(indian-font-char-range 'cdac:as-ttdurga) |
8d9a9cbd | 110 | . (nil . "Assamese-CDAC")) |
a030d0e1 | 111 | (,(indian-font-char-range 'cdac:pn-ttamar) |
8d9a9cbd | 112 | . (nil . "Punjabi-CDAC")) |
a030d0e1 | 113 | (,(indian-font-char-range 'cdac:gj-ttavantika) |
8d9a9cbd | 114 | . (nil . "Gujarati-CDAC")) |
a030d0e1 | 115 | (,(indian-font-char-range 'cdac:or-ttsarala) |
8d9a9cbd | 116 | . (nil . "Oriya-CDAC")) |
a030d0e1 | 117 | (,(indian-font-char-range 'cdac:tm-ttvalluvar) |
8d9a9cbd | 118 | . (nil . "Tamil-CDAC")) |
a030d0e1 | 119 | (,(indian-font-char-range 'cdac:tl-tthemalatha) |
8d9a9cbd | 120 | . (nil . "Telugu-CDAC")) |
a030d0e1 | 121 | (,(indian-font-char-range 'cdac:kn-ttuma) |
8d9a9cbd | 122 | . (nil . "Kannada-CDAC")) |
a030d0e1 | 123 | (,(indian-font-char-range 'cdac:ml-ttkarthika) |
8d9a9cbd | 124 | . (nil . "Malayalam-CDAC")) |
a030d0e1 KH |
125 | ;; Indian AKRUTI |
126 | (,(indian-font-char-range 'akruti:dev) | |
8d9a9cbd | 127 | . (nil . "Devanagari-Akruti")) |
a030d0e1 | 128 | (,(indian-font-char-range 'akruti:bng) |
8d9a9cbd | 129 | . (nil . "Bengali-Akruti")) |
a030d0e1 | 130 | (,(indian-font-char-range 'akruti:pnj) |
8d9a9cbd | 131 | . (nil . "Punjabi-Akruti")) |
a030d0e1 | 132 | (,(indian-font-char-range 'akruti:guj) |
8d9a9cbd | 133 | . (nil . "Gujarati-Akruti")) |
a030d0e1 | 134 | (,(indian-font-char-range 'akruti:ori) |
d8773eda | 135 | . (nil . "Oriya-Akruti")) |
a030d0e1 | 136 | (,(indian-font-char-range 'akruti:tml) |
8d9a9cbd | 137 | . (nil . "Tamil-Akruti")) |
a030d0e1 | 138 | (,(indian-font-char-range 'akruti:tlg) |
8d9a9cbd | 139 | . (nil . "Telugu-Akruti")) |
a030d0e1 | 140 | (,(indian-font-char-range 'akruti:knd) |
8d9a9cbd | 141 | . (nil . "Kannada-Akruti")) |
a030d0e1 | 142 | (,(indian-font-char-range 'akruti:mal) |
8d9a9cbd | 143 | . (nil . "Malayalam-Akruti")) |
a030d0e1 | 144 | )) |
c963bbc2 | 145 | (set-fontset-font "fontset-default" (car elt) (cdr elt)))) |
4ed46869 KH |
146 | |
147 | ;; Set arguments in `font-encoding-alist' (which see). | |
148 | (defun set-font-encoding (pattern charset encoding) | |
149 | (let ((slot (assoc pattern font-encoding-alist))) | |
150 | (if slot | |
151 | (let ((place (assq charset (cdr slot)))) | |
152 | (if place | |
153 | (setcdr place encoding) | |
154 | (setcdr slot (cons (cons charset encoding) (cdr slot))))) | |
155 | (setq font-encoding-alist | |
156 | (cons (list pattern (cons charset encoding)) font-encoding-alist))) | |
157 | )) | |
158 | ||
84fa2951 KH |
159 | ;; Allow display of arbitrary characters with an iso-10646-encoded |
160 | ;; (`Unicode') font. | |
161 | (define-translation-table 'ucs-mule-to-mule-unicode | |
162 | ucs-mule-to-mule-unicode) | |
163 | (define-translation-hash-table 'ucs-mule-cjk-to-unicode | |
164 | ucs-mule-cjk-to-unicode) | |
165 | ||
adbff2a7 | 166 | (define-ccl-program ccl-encode-unicode-font |
12385722 | 167 | `(0 |
84fa2951 KH |
168 | ;; r0: charset-id |
169 | ;; r1: 1st position code | |
170 | ;; r2: 2nd position code (if r0 is 2D charset) | |
171 | ((if (r0 == ,(charset-id 'ascii)) | |
172 | ((r2 = r1) | |
173 | (r1 = 0)) | |
174 | ;; At first, try to get a Unicode code point directly. | |
175 | ((if (r2 >= 0) | |
176 | ;; This is a 2D charset. | |
177 | (r1 = ((r1 << 7) | r2))) | |
f086544b | 178 | (lookup-character utf-subst-table-for-encode r0 r1) |
84fa2951 KH |
179 | (if r7 |
180 | ;; We got it! | |
181 | ((r1 = (r0 >> 8)) | |
182 | (r2 = (r0 & #xFF))) | |
183 | ;; Look for a translation for non-ASCII chars. | |
184 | ((translate-character ucs-mule-to-mule-unicode r0 r1) | |
f086544b KH |
185 | (if (r0 == ,(charset-id 'ascii)) |
186 | ((r2 = r1) | |
84fa2951 | 187 | (r1 = 0)) |
f086544b KH |
188 | ((if (r0 == ,(charset-id 'latin-iso8859-1)) |
189 | ((r2 = (r1 + 128)) | |
190 | (r1 = 0)) | |
191 | ((r2 = (r1 & #x7F)) | |
192 | (r1 >>= 7) | |
193 | (if (r0 == ,(charset-id 'mule-unicode-0100-24ff)) | |
194 | ((r1 *= 96) | |
195 | (r1 += r2) | |
196 | (r1 += ,(- #x100 (* 32 96) 32)) | |
197 | (r1 >8= 0) | |
198 | (r2 = r7)) | |
199 | (if (r0 == ,(charset-id 'mule-unicode-2500-33ff)) | |
200 | ((r1 *= 96) | |
201 | (r1 += r2) | |
202 | (r1 += ,(- #x2500 (* 32 96) 32)) | |
203 | (r1 >8= 0) | |
204 | (r2 = r7)) | |
205 | (if (r0 == ,(charset-id 'mule-unicode-e000-ffff)) | |
206 | ((r1 *= 96) | |
207 | (r1 += r2) | |
208 | (r1 += ,(- #xe000 (* 32 96) 32)) | |
209 | (r1 >8= 0) | |
210 | (r2 = r7)) | |
211 | ;; No way, use the glyph for U+FFFD. | |
212 | ((r1 = #xFF) | |
213 | (r2 = #xFD))))))))))))))) | |
84fa2951 KH |
214 | "Encode characters for display with iso10646 font. |
215 | Translate through the translation-hash-table named | |
216 | `ucs-mule-cjk-to-unicode' and the translation-table named | |
217 | `ucs-mule-to-mule-unicode' initially.") | |
12385722 | 218 | |
84fa2951 KH |
219 | ;; Use the above CCL encoder for Unicode fonts. Please note that the |
220 | ;; regexp is not simply "ISO10646-1" because there exists, for | |
221 | ;; instance, the following Devanagari Unicode fonts: | |
222 | ;; -misc-fixed-medium-r-normal--24-240-72-72-c-120-iso10646.indian-1 | |
223 | ;; -sibal-devanagari-medium-r-normal--24-240-75-75-P--iso10646-dev | |
12385722 | 224 | (setq font-ccl-encoder-alist |
84fa2951 | 225 | (cons '("ISO10646.*-*" . ccl-encode-unicode-font) |
12385722 KH |
226 | font-ccl-encoder-alist)) |
227 | ||
4ed46869 KH |
228 | ;; Setting for suppressing XLoadQueryFont on big fonts. |
229 | (setq x-pixel-size-width-font-regexp | |
230 | "gb2312\\|jisx0208\\|ksc5601\\|cns11643\\|big5") | |
231 | ||
6eca8d93 | 232 | ;; These fonts require vertical centering. |
0c4f97d0 | 233 | (setq vertical-centering-font-regexp |
6eca8d93 | 234 | "gb2312\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5") |
0c4f97d0 | 235 | |
e46947a5 KH |
236 | ;; CDAC fonts are actually smaller than their design sizes. |
237 | (setq face-font-rescale-alist | |
238 | '(("-cdac$" . 1.3))) | |
239 | ||
6fb8f8bd KH |
240 | (defvar x-font-name-charset-alist |
241 | '(("iso8859-1" ascii latin-iso8859-1) | |
242 | ("iso8859-2" ascii latin-iso8859-2) | |
243 | ("iso8859-3" ascii latin-iso8859-3) | |
244 | ("iso8859-4" ascii latin-iso8859-4) | |
245 | ("iso8859-5" ascii cyrillic-iso8859-5) | |
246 | ("iso8859-6" ascii arabic-iso8859-6) | |
247 | ("iso8859-7" ascii greek-iso8859-7) | |
248 | ("iso8859-8" ascii hebrew-iso8859-8) | |
7a860cf2 DL |
249 | ("iso8859-14" ascii latin-iso8859-14) |
250 | ("iso8859-15" ascii latin-iso8859-15) | |
6fb8f8bd KH |
251 | ("tis620" ascii thai-tis620) |
252 | ("koi8" ascii cyrillic-iso8859-5) | |
253 | ("viscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower) | |
254 | ("vscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower) | |
12385722 | 255 | ("mulelao-1" ascii lao) |
adbff2a7 KH |
256 | ("iso10646-1" ascii latin-iso8859-1 mule-unicode-0100-24ff |
257 | mule-unicode-2500-33ff mule-unicode-e000-ffff)) | |
6fb8f8bd KH |
258 | "Alist of font names vs list of charsets the font can display. |
259 | ||
260 | When a font name which matches some element of this alist is given as | |
261 | `-fn' command line argument or is specified by X resource, a fontset | |
262 | which uses the specified font for the corresponding charsets are | |
263 | created and used for the initial frame.") | |
264 | ||
4ed46869 KH |
265 | ;;; XLFD (X Logical Font Description) format handler. |
266 | ||
267 | ;; Define XLFD's field index numbers. ; field name | |
268 | (defconst xlfd-regexp-foundry-subnum 0) ; FOUNDRY | |
269 | (defconst xlfd-regexp-family-subnum 1) ; FAMILY_NAME | |
270 | (defconst xlfd-regexp-weight-subnum 2) ; WEIGHT_NAME | |
271 | (defconst xlfd-regexp-slant-subnum 3) ; SLANT | |
272 | (defconst xlfd-regexp-swidth-subnum 4) ; SETWIDTH_NAME | |
273 | (defconst xlfd-regexp-adstyle-subnum 5) ; ADD_STYLE_NAME | |
274 | (defconst xlfd-regexp-pixelsize-subnum 6) ; PIXEL_SIZE | |
275 | (defconst xlfd-regexp-pointsize-subnum 7) ; POINT_SIZE | |
276 | (defconst xlfd-regexp-resx-subnum 8) ; RESOLUTION_X | |
277 | (defconst xlfd-regexp-resy-subnum 9) ; RESOLUTION_Y | |
278 | (defconst xlfd-regexp-spacing-subnum 10) ; SPACING | |
279 | (defconst xlfd-regexp-avgwidth-subnum 11) ; AVERAGE_WIDTH | |
280 | (defconst xlfd-regexp-registry-subnum 12) ; CHARSET_REGISTRY | |
281 | (defconst xlfd-regexp-encoding-subnum 13) ; CHARSET_ENCODING | |
282 | ||
283 | ;; Regular expression matching against a fontname which conforms to | |
284 | ;; XLFD (X Logical Font Description). All fields in XLFD should be | |
285 | ;; not be omitted (but can be a wild card) to be matched. | |
286 | (defconst xlfd-tight-regexp | |
287 | "^\ | |
288 | -\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\ | |
289 | -\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\ | |
290 | -\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)$") | |
291 | ||
292 | ;; List of field numbers of XLFD whose values are numeric. | |
293 | (defconst xlfd-regexp-numeric-subnums | |
294 | (list xlfd-regexp-pixelsize-subnum ;6 | |
295 | xlfd-regexp-pointsize-subnum ;7 | |
296 | xlfd-regexp-resx-subnum ;8 | |
297 | xlfd-regexp-resy-subnum ;9 | |
298 | xlfd-regexp-avgwidth-subnum ;11 | |
299 | )) | |
300 | ||
301 | (defun x-decompose-font-name (pattern) | |
302 | "Decompose PATTERN into XLFD's fields and return vector of the fields. | |
303 | The length of the vector is 14. | |
304 | ||
305 | If PATTERN doesn't conform to XLFD, try to get a full XLFD name from | |
306 | X server and use the information of the full name to decompose | |
307 | PATTERN. If no full XLFD name is gotten, return nil." | |
308 | (let (xlfd-fields fontname) | |
309 | (if (string-match xlfd-tight-regexp pattern) | |
310 | (let ((i 0)) | |
311 | (setq xlfd-fields (make-vector 14 nil)) | |
312 | (while (< i 14) | |
313 | (aset xlfd-fields i (match-string (1+ i) pattern)) | |
314 | (setq i (1+ i))) | |
315 | xlfd-fields) | |
316 | (setq fontname (condition-case nil | |
317 | (x-resolve-font-name pattern) | |
318 | (error))) | |
319 | (if (and fontname | |
320 | (string-match xlfd-tight-regexp fontname)) | |
190ce634 | 321 | ;; We get a full XLFD name. |
4ed46869 KH |
322 | (let ((len (length pattern)) |
323 | (i 0) | |
324 | l) | |
190ce634 KH |
325 | ;; Setup xlfd-fields by the full XLFD name. Each element |
326 | ;; should be a cons of matched index and matched string. | |
4ed46869 KH |
327 | (setq xlfd-fields (make-vector 14 nil)) |
328 | (while (< i 14) | |
329 | (aset xlfd-fields i | |
330 | (cons (match-beginning (1+ i)) | |
331 | (match-string (1+ i) fontname))) | |
332 | (setq i (1+ i))) | |
190ce634 KH |
333 | |
334 | ;; Replace wild cards in PATTERN by regexp codes. | |
4ed46869 KH |
335 | (setq i 0) |
336 | (while (< i len) | |
337 | (let ((ch (aref pattern i))) | |
338 | (if (= ch ??) | |
339 | (setq pattern (concat (substring pattern 0 i) | |
340 | "\\(.\\)" | |
341 | (substring pattern (1+ i))) | |
342 | len (+ len 4) | |
343 | i (+ i 4)) | |
344 | (if (= ch ?*) | |
345 | (setq pattern (concat (substring pattern 0 i) | |
346 | "\\(.*\\)" | |
347 | (substring pattern (1+ i))) | |
348 | len (+ len 5) | |
349 | i (+ i 5)) | |
350 | (setq i (1+ i)))))) | |
190ce634 KH |
351 | |
352 | ;; Set each element of xlfd-fields to proper strings. | |
353 | (if (string-match pattern fontname) | |
354 | ;; The regular expression PATTERN matchs the full XLFD | |
355 | ;; name. Set elements that correspond to a wild card | |
356 | ;; in PATTERN to "*", set the other elements to the | |
357 | ;; exact strings in PATTERN. | |
358 | (let ((l (cdr (cdr (match-data))))) | |
359 | (setq i 0) | |
360 | (while (< i 14) | |
361 | (if (or (null l) (< (car (aref xlfd-fields i)) (car l))) | |
362 | (progn | |
363 | (aset xlfd-fields i (cdr (aref xlfd-fields i))) | |
364 | (setq i (1+ i))) | |
365 | (if (< (car (aref xlfd-fields i)) (car (cdr l))) | |
366 | (progn | |
367 | (aset xlfd-fields i "*") | |
368 | (setq i (1+ i))) | |
369 | (setq l (cdr (cdr l))))))) | |
370 | ;; Set each element of xlfd-fields to the exact string | |
371 | ;; in the corresonding fields in full XLFD name. | |
372 | (setq i 0) | |
373 | (while (< i 14) | |
374 | (aset xlfd-fields i (cdr (aref xlfd-fields i))) | |
375 | (setq i (1+ i)))) | |
4ed46869 KH |
376 | xlfd-fields))))) |
377 | ||
441038a6 KH |
378 | ;; Replace consecutive wild-cards (`*') in NAME to one. |
379 | ;; Ex. (x-reduce-font-name "-*-*-*-iso8859-1") => "-*-iso8859-1" | |
380 | (defsubst x-reduce-font-name (name) | |
381 | (while (string-match "-\\*-\\(\\*-\\)+" name) | |
382 | (setq name (replace-match "-*-" t t name))) | |
383 | name) | |
384 | ||
bb98ead9 | 385 | (defun x-compose-font-name (fields &optional reduce) |
4ed46869 | 386 | "Compose X's fontname from FIELDS. |
33fac697 | 387 | FIELDS is a vector of XLFD fields, of length 14. |
441038a6 | 388 | If a field is nil, wild-card letter `*' is embedded. |
33fac697 JB |
389 | Optional argument REDUCE exists just for backward compatibility, |
390 | and is always ignored." | |
6eca8d93 | 391 | (concat "-" (mapconcat (lambda (x) (or x "*")) fields "-"))) |
bcb68cff | 392 | |
4fbe2b13 GM |
393 | |
394 | (defun x-must-resolve-font-name (xlfd-fields) | |
395 | "Like `x-resolve-font-name', but always return a font name. | |
396 | XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields. | |
397 | If no font matching XLFD-FIELDS is available, successively replace | |
398 | parts of the font name pattern with \"*\" until some font is found. | |
399 | Value is name of that font." | |
400 | (let ((ascii-font nil) (index 0)) | |
401 | (while (and (null ascii-font) (<= index xlfd-regexp-encoding-subnum)) | |
402 | (let ((pattern (x-compose-font-name xlfd-fields))) | |
403 | (condition-case nil | |
404 | (setq ascii-font (x-resolve-font-name pattern)) | |
405 | (error | |
406 | (message "Warning: no fonts matching `%s' available" pattern) | |
407 | (aset xlfd-fields index "*") | |
408 | (setq index (1+ index)))))) | |
409 | (unless ascii-font | |
37aad8f5 | 410 | (error "No fonts found")) |
4fbe2b13 GM |
411 | ascii-font)) |
412 | ||
413 | ||
4ed46869 | 414 | (defun x-complement-fontset-spec (xlfd-fields fontlist) |
6eca8d93 | 415 | "Complement FONTLIST for charsets based on XLFD-FIELDS and return it. |
4ed46869 | 416 | XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields. |
6fb8f8bd | 417 | FONTLIST is an alist of charsets vs the corresponding font names. |
4ed46869 | 418 | |
6eca8d93 KH |
419 | The fonts are complemented as below. |
420 | ||
421 | If FONTLIST doesn't specify a font for ASCII charset, generate a font | |
422 | name for the charset from XLFD-FIELDS, and add that information to | |
423 | FONTLIST. | |
424 | ||
425 | If a font specifid for ASCII supports the other charsets (see the | |
426 | variable `x-font-name-charset-alist'), add that information to FONTLIST." | |
f6cab6c8 | 427 | (let* ((slot (assq 'ascii fontlist)) |
6bf84cde KH |
428 | (ascii-font (cdr slot)) |
429 | ascii-font-spec) | |
f6cab6c8 KH |
430 | (if ascii-font |
431 | (setcdr slot (setq ascii-font (x-resolve-font-name ascii-font))) | |
432 | ;; If font for ASCII is not specified, add it. | |
2ad00186 KH |
433 | (aset xlfd-fields xlfd-regexp-registry-subnum "iso8859") |
434 | (aset xlfd-fields xlfd-regexp-encoding-subnum "1") | |
4fbe2b13 | 435 | (setq ascii-font (x-must-resolve-font-name xlfd-fields)) |
2ad00186 | 436 | (setq fontlist (cons (cons 'ascii ascii-font) fontlist))) |
6eca8d93 KH |
437 | |
438 | ;; If the font for ASCII also supports the other charsets, and | |
439 | ;; they are not specified in FONTLIST, add them. | |
6bf84cde KH |
440 | (setq xlfd-fields (x-decompose-font-name ascii-font)) |
441 | (if (not xlfd-fields) | |
442 | (setq ascii-font-spec ascii-font) | |
443 | (setq ascii-font-spec | |
444 | (cons (format "%s-%s" | |
445 | (aref xlfd-fields xlfd-regexp-foundry-subnum) | |
446 | (aref xlfd-fields xlfd-regexp-family-subnum)) | |
447 | (format "%s-%s" | |
448 | (aref xlfd-fields xlfd-regexp-registry-subnum) | |
449 | (aref xlfd-fields xlfd-regexp-encoding-subnum))))) | |
6eca8d93 KH |
450 | (let ((tail x-font-name-charset-alist) |
451 | elt) | |
452 | (while tail | |
453 | (setq elt (car tail) tail (cdr tail)) | |
454 | (if (string-match (car elt) ascii-font) | |
455 | (let ((charsets (cdr elt)) | |
456 | charset) | |
457 | (while charsets | |
458 | (setq charset (car charsets) charsets (cdr charsets)) | |
459 | (or (assq charset fontlist) | |
460 | (setq fontlist | |
6bf84cde | 461 | (cons (cons charset ascii-font-spec) fontlist)))))))) |
a1506d29 | 462 | |
6eca8d93 | 463 | fontlist)) |
4ed46869 | 464 | |
35d4066a KH |
465 | (defun fontset-name-p (fontset) |
466 | "Return non-nil if FONTSET is valid as fontset name. | |
467 | A valid fontset name should conform to XLFD (X Logical Font Description) | |
33fac697 | 468 | with \"fontset\" in `<CHARSET_REGISTRY>' field." |
35d4066a KH |
469 | (and (string-match xlfd-tight-regexp fontset) |
470 | (string= (match-string (1+ xlfd-regexp-registry-subnum) fontset) | |
471 | "fontset"))) | |
472 | ||
4ed46869 KH |
473 | ;; Return a list to be appended to `x-fixed-font-alist' when |
474 | ;; `mouse-set-font' is called. | |
475 | (defun generate-fontset-menu () | |
6eca8d93 | 476 | (let ((fontsets (fontset-list)) |
4ed46869 KH |
477 | fontset-name |
478 | l) | |
479 | (while fontsets | |
6eca8d93 | 480 | (setq fontset-name (car fontsets) fontsets (cdr fontsets)) |
494ec9bc | 481 | (setq l (cons (list (fontset-plain-name fontset-name) fontset-name) l))) |
80ae5f3a KH |
482 | (cons "Fontset" |
483 | (sort l (function (lambda (x y) (string< (car x) (car y)))))))) | |
4ed46869 KH |
484 | |
485 | (defun fontset-plain-name (fontset) | |
486 | "Return a plain and descriptive name of FONTSET." | |
494ec9bc KH |
487 | (if (not (setq fontset (query-fontset fontset))) |
488 | (error "Invalid fontset: %s" fontset)) | |
4ed46869 KH |
489 | (let ((xlfd-fields (x-decompose-font-name fontset))) |
490 | (if xlfd-fields | |
491 | (let ((weight (aref xlfd-fields xlfd-regexp-weight-subnum)) | |
492 | (slant (aref xlfd-fields xlfd-regexp-slant-subnum)) | |
493 | (swidth (aref xlfd-fields xlfd-regexp-swidth-subnum)) | |
494 | (size (aref xlfd-fields xlfd-regexp-pixelsize-subnum)) | |
494ec9bc KH |
495 | (charset (aref xlfd-fields xlfd-regexp-registry-subnum)) |
496 | (nickname (aref xlfd-fields xlfd-regexp-encoding-subnum)) | |
4ed46869 | 497 | name) |
494ec9bc | 498 | (if (not (string= "fontset" charset)) |
4ed46869 | 499 | fontset |
027a4b6b | 500 | (if (> (string-to-number size) 0) |
494ec9bc KH |
501 | (setq name (format "%s: %s-dot" nickname size)) |
502 | (setq name nickname)) | |
503 | (cond ((string-match "^medium$" weight) | |
504 | (setq name (concat name " " "medium"))) | |
505 | ((string-match "^bold$\\|^demibold$" weight) | |
506 | (setq name (concat name " " weight)))) | |
507 | (cond ((string-match "^i$" slant) | |
508 | (setq name (concat name " " "italic"))) | |
509 | ((string-match "^o$" slant) | |
510 | (setq name (concat name " " "slant"))) | |
511 | ((string-match "^ri$" slant) | |
512 | (setq name (concat name " " "reverse italic"))) | |
513 | ((string-match "^ro$" slant) | |
514 | (setq name (concat name " " "reverse slant")))) | |
4ed46869 KH |
515 | name)) |
516 | fontset))) | |
517 | ||
c963bbc2 | 518 | |
6fb8f8bd | 519 | (defun create-fontset-from-fontset-spec (fontset-spec |
bb98ead9 | 520 | &optional style-variant noerror) |
4ed46869 KH |
521 | "Create a fontset from fontset specification string FONTSET-SPEC. |
522 | FONTSET-SPEC is a string of the format: | |
fd40398d | 523 | FONTSET-NAME,CHARSET0:FONT0,CHARSET1:FONT1, ... |
494ec9bc | 524 | Any number of SPACE, TAB, and NEWLINE can be put before and after commas. |
bb98ead9 | 525 | |
fd40398d | 526 | Optional 2nd arg exists just for backward compatibility, and is ignored. |
bb98ead9 | 527 | |
33fac697 | 528 | If this function attempts to create already existing fontset, an error is |
1f50fef9 KH |
529 | signaled unless the optional 3rd argument NOERROR is non-nil. |
530 | ||
531 | It returns a name of the created fontset." | |
494ec9bc KH |
532 | (if (not (string-match "^[^,]+" fontset-spec)) |
533 | (error "Invalid fontset spec: %s" fontset-spec)) | |
6eca8d93 | 534 | (setq fontset-spec (downcase fontset-spec)) |
494ec9bc KH |
535 | (let ((idx (match-end 0)) |
536 | (name (match-string 0 fontset-spec)) | |
6eca8d93 | 537 | xlfd-fields charset fontlist ascii-font) |
6fb8f8bd | 538 | (if (query-fontset name) |
a1506d29 | 539 | (or noerror |
86e411c9 | 540 | (error "Fontset \"%s\" already exists" name)) |
6eca8d93 KH |
541 | (setq xlfd-fields (x-decompose-font-name name)) |
542 | (or xlfd-fields | |
543 | (error "Fontset \"%s\" not conforming to XLFD" name)) | |
544 | ||
6fb8f8bd | 545 | ;; At first, extract pairs of charset and fontname from FONTSET-SPEC. |
50e3e564 KH |
546 | (while (string-match "[, \t\n]*\\([^:]+\\):[ \t]*\\([^,]+\\)" |
547 | fontset-spec idx) | |
6fb8f8bd KH |
548 | (setq idx (match-end 0)) |
549 | (setq charset (intern (match-string 1 fontset-spec))) | |
550 | (if (charsetp charset) | |
551 | (setq fontlist (cons (cons charset (match-string 2 fontset-spec)) | |
552 | fontlist)))) | |
f6cab6c8 | 553 | (setq ascii-font (cdr (assq 'ascii fontlist))) |
6eca8d93 KH |
554 | |
555 | ;; Complement FONTLIST. | |
556 | (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist)) | |
557 | ||
558 | (new-fontset name fontlist) | |
559 | ||
560 | ;; Define the short name alias. | |
561 | (if (and (string-match "fontset-.*$" name) | |
562 | (not (assoc name fontset-alias-alist))) | |
563 | (let ((alias (match-string 0 name))) | |
564 | (or (rassoc alias fontset-alias-alist) | |
565 | (setq fontset-alias-alist | |
566 | (cons (cons name alias) fontset-alias-alist))))) | |
567 | ||
568 | ;; Define the ASCII font name alias. | |
f6cab6c8 KH |
569 | (or ascii-font |
570 | (setq ascii-font (cdr (assq 'ascii fontlist)))) | |
6eca8d93 KH |
571 | (or (rassoc ascii-font fontset-alias-alist) |
572 | (setq fontset-alias-alist | |
573 | (cons (cons name ascii-font) | |
574 | fontset-alias-alist)))) | |
6fb8f8bd | 575 | |
1f50fef9 KH |
576 | name)) |
577 | ||
578 | (defun create-fontset-from-ascii-font (font &optional resolved-font | |
579 | fontset-name) | |
580 | "Create a fontset from an ASCII font FONT. | |
581 | ||
33fac697 JB |
582 | Optional 2nd arg RESOLVED-FONT is a resolved name of FONT. |
583 | If omitted, `x-resolve-font-name' is called to get the resolved name. | |
584 | At this time, if FONT is not available, an error is signaled. | |
1f50fef9 | 585 | |
33fac697 | 586 | Optional 3rd arg FONTSET-NAME is a string to be used in |
1f50fef9 KH |
587 | `<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted, |
588 | an appropriate name is generated automatically. | |
589 | ||
1f50fef9 | 590 | It returns a name of the created fontset." |
6eca8d93 KH |
591 | (setq font (downcase font)) |
592 | (if resolved-font | |
593 | (setq resolved-font (downcase resolved-font)) | |
594 | (setq resolved-font (downcase (x-resolve-font-name font)))) | |
595 | (let ((xlfd (x-decompose-font-name font)) | |
596 | (resolved-xlfd (x-decompose-font-name resolved-font)) | |
597 | fontset fontset-spec) | |
1f50fef9 KH |
598 | (aset xlfd xlfd-regexp-foundry-subnum nil) |
599 | (aset xlfd xlfd-regexp-family-subnum nil) | |
600 | (aset xlfd xlfd-regexp-registry-subnum "fontset") | |
6eca8d93 KH |
601 | (if fontset-name |
602 | (setq fontset-name (downcase fontset-name)) | |
603 | (setq fontset-name | |
604 | (format "%s_%s_%s" | |
605 | (aref resolved-xlfd xlfd-regexp-registry-subnum) | |
606 | (aref resolved-xlfd xlfd-regexp-encoding-subnum) | |
607 | (aref resolved-xlfd xlfd-regexp-pixelsize-subnum)))) | |
1f50fef9 | 608 | (aset xlfd xlfd-regexp-encoding-subnum fontset-name) |
1f50fef9 KH |
609 | (setq fontset (x-compose-font-name xlfd)) |
610 | (or (query-fontset fontset) | |
6eca8d93 KH |
611 | (create-fontset-from-fontset-spec (concat fontset ", ascii:" font))))) |
612 | ||
4ed46869 | 613 | \f |
acfb10b8 | 614 | ;; Create standard fontset from 16 dots fonts which are the most widely |
80d4ea92 KH |
615 | ;; installed fonts. Fonts for Chinese-GB, Korean, and Chinese-CNS are |
616 | ;; specified here because FAMILY of those fonts are not "fixed" in | |
617 | ;; many cases. | |
acfb10b8 | 618 | (defvar standard-fontset-spec |
cdd675ad | 619 | (purecopy "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard, |
4ed46869 KH |
620 | chinese-gb2312:-*-medium-r-normal-*-16-*-gb2312*-*, |
621 | korean-ksc5601:-*-medium-r-normal-*-16-*-ksc5601*-*, | |
622 | chinese-cns11643-1:-*-medium-r-normal-*-16-*-cns11643*-1, | |
623 | chinese-cns11643-2:-*-medium-r-normal-*-16-*-cns11643*-2, | |
624 | chinese-cns11643-3:-*-medium-r-normal-*-16-*-cns11643*-3, | |
625 | chinese-cns11643-4:-*-medium-r-normal-*-16-*-cns11643*-4, | |
626 | chinese-cns11643-5:-*-medium-r-normal-*-16-*-cns11643*-5, | |
627 | chinese-cns11643-6:-*-medium-r-normal-*-16-*-cns11643*-6, | |
cdd675ad | 628 | chinese-cns11643-7:-*-medium-r-normal-*-16-*-cns11643*-7") |
acfb10b8 KH |
629 | "String of fontset spec of the standard fontset. |
630 | You have the biggest chance to display international characters | |
631 | with correct glyphs by using the standard fontset. | |
4ed46869 KH |
632 | See the documentation of `create-fontset-from-fontset-spec' for the format.") |
633 | ||
634 | ;; Create fontsets from X resources of the name `fontset-N (class | |
635 | ;; Fontset-N)' where N is integer 0, 1, ... | |
636 | ;; The values of the resources the string of the same format as | |
acfb10b8 | 637 | ;; `standard-fontset-spec'. |
4ed46869 KH |
638 | |
639 | (defun create-fontset-from-x-resource () | |
640 | (let ((idx 0) | |
641 | fontset-spec) | |
cdd675ad DL |
642 | (while (setq fontset-spec (x-get-resource (format "fontset-%d" idx) |
643 | (format "Fontset-%d" idx))) | |
a5695549 | 644 | (create-fontset-from-fontset-spec fontset-spec t 'noerror) |
4ed46869 KH |
645 | (setq idx (1+ idx))))) |
646 | ||
4ed46869 KH |
647 | ;; |
648 | (provide 'fontset) | |
649 | ||
ab5796a9 | 650 | ;;; arch-tag: bb53e629-0234-403c-950e-551e61554849 |
4ed46869 | 651 | ;;; fontset.el ends here |