Commit | Line | Data |
---|---|---|
4ed46869 KH |
1 | ;;; fontset.el --- Commands for handling fontset. |
2 | ||
fa526c4a RS |
3 | ;; Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. |
4 | ;; Licensed to the Free Software Foundation. | |
4ed46869 KH |
5 | |
6 | ;; Keywords: mule, multilingual, fontset | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
369314dc KH |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
4ed46869 KH |
24 | |
25 | ;;; Code: | |
26 | ||
acfb10b8 | 27 | ;; Set standard REGISTRY property of charset to find an appropriate |
4ed46869 KH |
28 | ;; font for each charset. This is used to generate a font name in a |
29 | ;; fontset. If the value contains a character `-', the string before | |
30 | ;; that is embeded in `CHARSET_REGISTRY' field, and the string after | |
31 | ;; that is embeded in `CHARSET_ENCODING' field. If the value does not | |
32 | ;; contain `-', the whole string is embeded in `CHARSET_REGISTRY' | |
33 | ;; field, and a wild card character `*' is embeded in | |
34 | ;; `CHARSET_ENCODING' field. | |
35 | ||
36 | (defvar x-charset-registries | |
37 | '((ascii . "ISO8859-1") | |
38 | (latin-iso8859-1 . "ISO8859-1") | |
39 | (latin-iso8859-2 . "ISO8859-2") | |
40 | (latin-iso8859-3 . "ISO8859-3") | |
41 | (latin-iso8859-4 . "ISO8859-4") | |
42 | (thai-tis620 . "TIS620") | |
43 | (greek-iso8859-7 . "ISO8859-7") | |
44 | (arabic-iso8859-6 . "ISO8859-6") | |
45 | (hebrew-iso8859-8 . "ISO8859-8") | |
46 | (katakana-jisx0201 . "JISX0201") | |
47 | (latin-jisx0201 . "JISX0201") | |
48 | (cyrillic-iso8859-5 . "ISO8859-5") | |
49 | (latin-iso8859-9 . "ISO8859-9") | |
50 | (japanese-jisx0208-1978 . "JISX0208.1978") | |
51 | (chinese-gb2312 . "GB2312") | |
52 | (japanese-jisx0208 . "JISX0208.1983") | |
53 | (korean-ksc5601 . "KSC5601") | |
54 | (japanese-jisx0212 . "JISX0212") | |
55 | (chinese-cns11643-1 . "CNS11643.1992-1") | |
56 | (chinese-cns11643-2 . "CNS11643.1992-2") | |
57 | (chinese-cns11643-3 . "CNS11643.1992-3") | |
58 | (chinese-cns11643-4 . "CNS11643.1992-4") | |
59 | (chinese-cns11643-5 . "CNS11643.1992-5") | |
60 | (chinese-cns11643-6 . "CNS11643.1992-6") | |
61 | (chinese-cns11643-7 . "CNS11643.1992-7") | |
62 | (chinese-big5-1 . "Big5") | |
63 | (chinese-big5-2 . "Big5") | |
64 | (chinese-sisheng . "sisheng_cwnn") | |
65 | (vietnamese-viscii-lower . "VISCII1.1") | |
66 | (vietnamese-viscii-upper . "VISCII1.1") | |
67 | (arabic-digit . "MuleArabic-0") | |
68 | (arabic-1-column . "MuleArabic-1") | |
69 | (arabic-2-column . "MuleArabic-2") | |
70 | (ipa . "MuleIPA") | |
441038a6 | 71 | (ethiopic . "Ethiopic-Unicode") |
4ed46869 KH |
72 | (ascii-right-to-left . "ISO8859-1") |
73 | (indian-is13194 . "IS13194-Devanagari") | |
74 | (indian-2-column . "MuleIndian-2") | |
75 | (indian-1-column . "MuleIndian-1") | |
2e18c9dd KH |
76 | (lao . "MuleLao-1") |
77 | (tibetan . "MuleTibetan-0") | |
78 | (tibetan-1-column . "MuleTibetan-1") | |
b55b5129 | 79 | )) |
4ed46869 KH |
80 | |
81 | (let ((l x-charset-registries)) | |
82 | (while l | |
2316704a RS |
83 | (condition-case nil |
84 | (put-charset-property (car (car l)) 'x-charset-registry (cdr (car l))) | |
85 | (error nil)) | |
4ed46869 KH |
86 | (setq l (cdr l)))) |
87 | ||
88 | ;; Set arguments in `font-encoding-alist' (which see). | |
89 | (defun set-font-encoding (pattern charset encoding) | |
90 | (let ((slot (assoc pattern font-encoding-alist))) | |
91 | (if slot | |
92 | (let ((place (assq charset (cdr slot)))) | |
93 | (if place | |
94 | (setcdr place encoding) | |
95 | (setcdr slot (cons (cons charset encoding) (cdr slot))))) | |
96 | (setq font-encoding-alist | |
97 | (cons (list pattern (cons charset encoding)) font-encoding-alist))) | |
98 | )) | |
99 | ||
100 | (set-font-encoding "ISO8859-1" 'ascii 0) | |
101 | (set-font-encoding "JISX0201" 'latin-jisx0201 0) | |
102 | ||
103 | ;; Setting for suppressing XLoadQueryFont on big fonts. | |
104 | (setq x-pixel-size-width-font-regexp | |
105 | "gb2312\\|jisx0208\\|ksc5601\\|cns11643\\|big5") | |
106 | ||
6fb8f8bd KH |
107 | (defvar x-font-name-charset-alist |
108 | '(("iso8859-1" ascii latin-iso8859-1) | |
109 | ("iso8859-2" ascii latin-iso8859-2) | |
110 | ("iso8859-3" ascii latin-iso8859-3) | |
111 | ("iso8859-4" ascii latin-iso8859-4) | |
112 | ("iso8859-5" ascii cyrillic-iso8859-5) | |
113 | ("iso8859-6" ascii arabic-iso8859-6) | |
114 | ("iso8859-7" ascii greek-iso8859-7) | |
115 | ("iso8859-8" ascii hebrew-iso8859-8) | |
116 | ("tis620" ascii thai-tis620) | |
117 | ("koi8" ascii cyrillic-iso8859-5) | |
118 | ("viscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower) | |
119 | ("vscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower) | |
120 | ("mulelao-1" ascii lao)) | |
121 | "Alist of font names vs list of charsets the font can display. | |
122 | ||
123 | When a font name which matches some element of this alist is given as | |
124 | `-fn' command line argument or is specified by X resource, a fontset | |
125 | which uses the specified font for the corresponding charsets are | |
126 | created and used for the initial frame.") | |
127 | ||
4ed46869 KH |
128 | ;;; XLFD (X Logical Font Description) format handler. |
129 | ||
130 | ;; Define XLFD's field index numbers. ; field name | |
131 | (defconst xlfd-regexp-foundry-subnum 0) ; FOUNDRY | |
132 | (defconst xlfd-regexp-family-subnum 1) ; FAMILY_NAME | |
133 | (defconst xlfd-regexp-weight-subnum 2) ; WEIGHT_NAME | |
134 | (defconst xlfd-regexp-slant-subnum 3) ; SLANT | |
135 | (defconst xlfd-regexp-swidth-subnum 4) ; SETWIDTH_NAME | |
136 | (defconst xlfd-regexp-adstyle-subnum 5) ; ADD_STYLE_NAME | |
137 | (defconst xlfd-regexp-pixelsize-subnum 6) ; PIXEL_SIZE | |
138 | (defconst xlfd-regexp-pointsize-subnum 7) ; POINT_SIZE | |
139 | (defconst xlfd-regexp-resx-subnum 8) ; RESOLUTION_X | |
140 | (defconst xlfd-regexp-resy-subnum 9) ; RESOLUTION_Y | |
141 | (defconst xlfd-regexp-spacing-subnum 10) ; SPACING | |
142 | (defconst xlfd-regexp-avgwidth-subnum 11) ; AVERAGE_WIDTH | |
143 | (defconst xlfd-regexp-registry-subnum 12) ; CHARSET_REGISTRY | |
144 | (defconst xlfd-regexp-encoding-subnum 13) ; CHARSET_ENCODING | |
145 | ||
146 | ;; Regular expression matching against a fontname which conforms to | |
147 | ;; XLFD (X Logical Font Description). All fields in XLFD should be | |
148 | ;; not be omitted (but can be a wild card) to be matched. | |
149 | (defconst xlfd-tight-regexp | |
150 | "^\ | |
151 | -\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\ | |
152 | -\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\ | |
153 | -\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)$") | |
154 | ||
155 | ;; List of field numbers of XLFD whose values are numeric. | |
156 | (defconst xlfd-regexp-numeric-subnums | |
157 | (list xlfd-regexp-pixelsize-subnum ;6 | |
158 | xlfd-regexp-pointsize-subnum ;7 | |
159 | xlfd-regexp-resx-subnum ;8 | |
160 | xlfd-regexp-resy-subnum ;9 | |
161 | xlfd-regexp-avgwidth-subnum ;11 | |
162 | )) | |
163 | ||
164 | (defun x-decompose-font-name (pattern) | |
165 | "Decompose PATTERN into XLFD's fields and return vector of the fields. | |
166 | The length of the vector is 14. | |
167 | ||
168 | If PATTERN doesn't conform to XLFD, try to get a full XLFD name from | |
169 | X server and use the information of the full name to decompose | |
170 | PATTERN. If no full XLFD name is gotten, return nil." | |
171 | (let (xlfd-fields fontname) | |
172 | (if (string-match xlfd-tight-regexp pattern) | |
173 | (let ((i 0)) | |
174 | (setq xlfd-fields (make-vector 14 nil)) | |
175 | (while (< i 14) | |
176 | (aset xlfd-fields i (match-string (1+ i) pattern)) | |
177 | (setq i (1+ i))) | |
178 | xlfd-fields) | |
179 | (setq fontname (condition-case nil | |
180 | (x-resolve-font-name pattern) | |
181 | (error))) | |
182 | (if (and fontname | |
183 | (string-match xlfd-tight-regexp fontname)) | |
184 | (let ((len (length pattern)) | |
185 | (i 0) | |
186 | l) | |
187 | (setq xlfd-fields (make-vector 14 nil)) | |
188 | (while (< i 14) | |
189 | (aset xlfd-fields i | |
190 | (cons (match-beginning (1+ i)) | |
191 | (match-string (1+ i) fontname))) | |
192 | (setq i (1+ i))) | |
193 | (setq i 0) | |
194 | (while (< i len) | |
195 | (let ((ch (aref pattern i))) | |
196 | (if (= ch ??) | |
197 | (setq pattern (concat (substring pattern 0 i) | |
198 | "\\(.\\)" | |
199 | (substring pattern (1+ i))) | |
200 | len (+ len 4) | |
201 | i (+ i 4)) | |
202 | (if (= ch ?*) | |
203 | (setq pattern (concat (substring pattern 0 i) | |
204 | "\\(.*\\)" | |
205 | (substring pattern (1+ i))) | |
206 | len (+ len 5) | |
207 | i (+ i 5)) | |
208 | (setq i (1+ i)))))) | |
209 | (string-match pattern fontname) | |
210 | (setq l (cdr (cdr (match-data)))) | |
211 | (setq i 0) | |
212 | (while (< i 14) | |
213 | (if (or (null l) (< (car (aref xlfd-fields i)) (car l))) | |
214 | (progn | |
215 | (aset xlfd-fields i (cdr (aref xlfd-fields i))) | |
216 | (setq i (1+ i))) | |
217 | (if (< (car (aref xlfd-fields i)) (car (cdr l))) | |
218 | (progn | |
494ec9bc | 219 | (aset xlfd-fields i "*") |
4ed46869 KH |
220 | (setq i (1+ i))) |
221 | (setq l (cdr (cdr l)))))) | |
222 | xlfd-fields))))) | |
223 | ||
441038a6 KH |
224 | ;; Replace consecutive wild-cards (`*') in NAME to one. |
225 | ;; Ex. (x-reduce-font-name "-*-*-*-iso8859-1") => "-*-iso8859-1" | |
226 | (defsubst x-reduce-font-name (name) | |
227 | (while (string-match "-\\*-\\(\\*-\\)+" name) | |
228 | (setq name (replace-match "-*-" t t name))) | |
229 | name) | |
230 | ||
bb98ead9 | 231 | (defun x-compose-font-name (fields &optional reduce) |
4ed46869 | 232 | "Compose X's fontname from FIELDS. |
bb98ead9 | 233 | FIELDS is a vector of XLFD fields, the length 14. |
441038a6 KH |
234 | If a field is nil, wild-card letter `*' is embedded. |
235 | Optional argument REDUCE non-nil means consecutive wild-cards are | |
236 | reduced to be one." | |
237 | (let ((name | |
bb98ead9 | 238 | (concat "-" (mapconcat (lambda (x) (or x "*")) fields "-")))) |
441038a6 KH |
239 | (if reduce |
240 | (x-reduce-font-name name) | |
241 | name))) | |
4ed46869 | 242 | |
800d3b18 KH |
243 | (defun register-alternate-fontnames (fontname) |
244 | "Register alternate fontnames for FONTNAME in `alternate-fontname-alist'. | |
6fb8f8bd | 245 | When Emacs fails to open FONTNAME, it tries to open an alternate font |
800d3b18 KH |
246 | registered in the variable `alternate-fontname-alist' (which see). |
247 | ||
248 | For FONTNAME, the following three alternate fontnames are registered: | |
249 | fontname which ignores style specification of FONTNAME, | |
250 | fontname which ignores size specification of FONTNAME, | |
6fb8f8bd KH |
251 | fontname which ignores both style and size specification of FONTNAME. |
252 | Emacs tries to open fonts in this order." | |
800d3b18 KH |
253 | (unless (assoc fontname alternate-fontname-alist) |
254 | (let ((xlfd-fields (x-decompose-font-name fontname)) | |
255 | style-ignored size-ignored both-ignored) | |
256 | (when xlfd-fields | |
257 | (aset xlfd-fields xlfd-regexp-foundry-subnum nil) | |
258 | (aset xlfd-fields xlfd-regexp-family-subnum nil) | |
259 | ||
260 | (let ((temp (copy-sequence xlfd-fields))) | |
261 | (aset temp xlfd-regexp-weight-subnum nil) | |
262 | (aset temp xlfd-regexp-slant-subnum nil) | |
263 | (aset temp xlfd-regexp-swidth-subnum nil) | |
264 | (aset temp xlfd-regexp-adstyle-subnum nil) | |
265 | (setq style-ignored (x-compose-font-name temp t))) | |
266 | ||
267 | (aset xlfd-fields xlfd-regexp-pixelsize-subnum nil) | |
268 | (aset xlfd-fields xlfd-regexp-pointsize-subnum nil) | |
269 | (aset xlfd-fields xlfd-regexp-resx-subnum nil) | |
270 | (aset xlfd-fields xlfd-regexp-resy-subnum nil) | |
271 | (aset xlfd-fields xlfd-regexp-spacing-subnum nil) | |
272 | (aset xlfd-fields xlfd-regexp-avgwidth-subnum nil) | |
273 | (setq size-ignored (x-compose-font-name xlfd-fields t)) | |
274 | ||
275 | (aset xlfd-fields xlfd-regexp-weight-subnum nil) | |
276 | (aset xlfd-fields xlfd-regexp-slant-subnum nil) | |
277 | (aset xlfd-fields xlfd-regexp-swidth-subnum nil) | |
278 | (aset xlfd-fields xlfd-regexp-adstyle-subnum nil) | |
279 | (setq both-ignored (x-compose-font-name xlfd-fields t)) | |
280 | ||
281 | (setq alternate-fontname-alist | |
282 | (cons (list fontname style-ignored size-ignored both-ignored) | |
283 | alternate-fontname-alist)))))) | |
284 | ||
4ed46869 KH |
285 | (defun x-complement-fontset-spec (xlfd-fields fontlist) |
286 | "Complement FONTLIST for all charsets based on XLFD-FIELDS and return it. | |
287 | XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields. | |
6fb8f8bd | 288 | FONTLIST is an alist of charsets vs the corresponding font names. |
4ed46869 | 289 | |
6fb8f8bd | 290 | Font names for charsets not listed in FONTLIST are generated from |
2e18c9dd | 291 | XLFD-FIELDS and a property of x-charset-registry of each charset |
4ed46869 | 292 | automatically." |
bb98ead9 KH |
293 | (let ((charsets charset-list) |
294 | (xlfd-fields-non-ascii (copy-sequence xlfd-fields)) | |
295 | (new-fontlist nil)) | |
296 | (aset xlfd-fields-non-ascii xlfd-regexp-foundry-subnum nil) | |
297 | (aset xlfd-fields-non-ascii xlfd-regexp-family-subnum nil) | |
298 | (aset xlfd-fields-non-ascii xlfd-regexp-adstyle-subnum nil) | |
299 | (aset xlfd-fields-non-ascii xlfd-regexp-avgwidth-subnum nil) | |
4ed46869 KH |
300 | (while charsets |
301 | (let ((charset (car charsets))) | |
800d3b18 | 302 | (unless (assq charset fontlist) |
bb98ead9 | 303 | (let ((registry (get-charset-property charset 'x-charset-registry)) |
6fb8f8bd | 304 | registry-val encoding-val fontname) |
800d3b18 KH |
305 | (if (string-match "-" registry) |
306 | ;; REGISTRY contains `CHARSET_ENCODING' field. | |
307 | (setq registry-val (substring registry 0 (match-beginning 0)) | |
308 | encoding-val (substring registry (match-end 0))) | |
309 | (setq registry-val (concat registry "*") | |
310 | encoding-val "*")) | |
bb98ead9 KH |
311 | (let ((xlfd (if (eq charset 'ascii) xlfd-fields |
312 | xlfd-fields-non-ascii))) | |
313 | (aset xlfd xlfd-regexp-registry-subnum registry-val) | |
314 | (aset xlfd xlfd-regexp-encoding-subnum encoding-val) | |
315 | (setq fontname (downcase (x-compose-font-name xlfd)))) | |
316 | (setq new-fontlist (cons (cons charset fontname) new-fontlist)) | |
800d3b18 | 317 | (register-alternate-fontnames fontname)))) |
bb98ead9 KH |
318 | (setq charsets (cdr charsets))) |
319 | ||
320 | ;; Be sure that ASCII font is avairable. | |
321 | (let ((slot (or (assq 'ascii fontlist) (assq 'ascii new-fontlist))) | |
322 | ascii-font) | |
323 | (if (setq ascii-font (condition-case nil | |
324 | (x-resolve-font-name (cdr slot)) | |
325 | (error nil))) | |
326 | (setcdr slot ascii-font)) | |
327 | (if ascii-font | |
328 | (let ((l x-font-name-charset-alist)) | |
329 | ;; If the ASCII font can also be used for another | |
330 | ;; charsets, use that font instead of what generated based | |
331 | ;; on x-charset-registery in the previous code. | |
332 | (while l | |
333 | (if (string-match (car (car l)) ascii-font) | |
334 | (let ((charsets (cdr (car l)))) | |
335 | (while charsets | |
336 | (if (and (not (eq (car charsets) 'ascii)) | |
337 | (setq slot (assq (car charsets) new-fontlist))) | |
338 | (setcdr slot ascii-font)) | |
339 | (setq charsets (cdr charsets))) | |
340 | (setq l nil)) | |
341 | (setq l (cdr l)))) | |
342 | (append fontlist new-fontlist)))))) | |
4ed46869 | 343 | |
35d4066a KH |
344 | (defun fontset-name-p (fontset) |
345 | "Return non-nil if FONTSET is valid as fontset name. | |
346 | A valid fontset name should conform to XLFD (X Logical Font Description) | |
347 | with \"fontset\" in `<CHARSET_REGISTRY> field." | |
348 | (and (string-match xlfd-tight-regexp fontset) | |
349 | (string= (match-string (1+ xlfd-regexp-registry-subnum) fontset) | |
350 | "fontset"))) | |
351 | ||
4ed46869 KH |
352 | ;; Return a list to be appended to `x-fixed-font-alist' when |
353 | ;; `mouse-set-font' is called. | |
354 | (defun generate-fontset-menu () | |
355 | (let ((fontsets global-fontset-alist) | |
356 | fontset-name | |
357 | l) | |
358 | (while fontsets | |
359 | (setq fontset-name (car (car fontsets)) fontsets (cdr fontsets)) | |
494ec9bc | 360 | (setq l (cons (list (fontset-plain-name fontset-name) fontset-name) l))) |
4ed46869 KH |
361 | (cons "Fontset" l))) |
362 | ||
363 | (defun fontset-plain-name (fontset) | |
364 | "Return a plain and descriptive name of FONTSET." | |
494ec9bc KH |
365 | (if (not (setq fontset (query-fontset fontset))) |
366 | (error "Invalid fontset: %s" fontset)) | |
4ed46869 KH |
367 | (let ((xlfd-fields (x-decompose-font-name fontset))) |
368 | (if xlfd-fields | |
369 | (let ((weight (aref xlfd-fields xlfd-regexp-weight-subnum)) | |
370 | (slant (aref xlfd-fields xlfd-regexp-slant-subnum)) | |
371 | (swidth (aref xlfd-fields xlfd-regexp-swidth-subnum)) | |
372 | (size (aref xlfd-fields xlfd-regexp-pixelsize-subnum)) | |
494ec9bc KH |
373 | (charset (aref xlfd-fields xlfd-regexp-registry-subnum)) |
374 | (nickname (aref xlfd-fields xlfd-regexp-encoding-subnum)) | |
4ed46869 | 375 | name) |
494ec9bc | 376 | (if (not (string= "fontset" charset)) |
4ed46869 | 377 | fontset |
494ec9bc KH |
378 | (if (> (string-to-int size) 0) |
379 | (setq name (format "%s: %s-dot" nickname size)) | |
380 | (setq name nickname)) | |
381 | (cond ((string-match "^medium$" weight) | |
382 | (setq name (concat name " " "medium"))) | |
383 | ((string-match "^bold$\\|^demibold$" weight) | |
384 | (setq name (concat name " " weight)))) | |
385 | (cond ((string-match "^i$" slant) | |
386 | (setq name (concat name " " "italic"))) | |
387 | ((string-match "^o$" slant) | |
388 | (setq name (concat name " " "slant"))) | |
389 | ((string-match "^ri$" slant) | |
390 | (setq name (concat name " " "reverse italic"))) | |
391 | ((string-match "^ro$" slant) | |
392 | (setq name (concat name " " "reverse slant")))) | |
4ed46869 KH |
393 | name)) |
394 | fontset))) | |
395 | ||
2725d3db RS |
396 | (defvar uninstantiated-fontset-alist nil |
397 | "Alist of fontset names vs. information for instantiating them. | |
6fb8f8bd | 398 | Each element has the form (FONTSET STYLE FONTLIST), where |
2725d3db | 399 | FONTSET is a name of fontset not yet instantiated. |
35d4066a KH |
400 | STYLE is a style of FONTSET, one of the followings: |
401 | bold, demobold, italic, oblique, | |
402 | bold-italic, demibold-italic, bold-oblique, demibold-oblique. | |
6fb8f8bd KH |
403 | FONTLIST is an alist of charsets vs font names to be used in FONSET.") |
404 | ||
d9691719 KH |
405 | (defconst x-style-funcs-alist |
406 | `((bold . x-make-font-bold) | |
407 | (demibold . x-make-font-demibold) | |
408 | (italic . x-make-font-italic) | |
409 | (oblique . x-make-font-oblique) | |
410 | (bold-italic . x-make-font-bold-italic) | |
411 | (demibold-italic | |
412 | . ,(function (lambda (x) | |
413 | (let ((y (x-make-font-demibold x))) | |
414 | (and y (x-make-font-italic y)))))) | |
415 | (demibold-oblique | |
416 | . ,(function (lambda (x) | |
417 | (let ((y (x-make-font-demibold x))) | |
418 | (and y (x-make-font-oblique y)))))) | |
419 | (bold-oblique | |
420 | . ,(function (lambda (x) | |
421 | (let ((y (x-make-font-bold x))) | |
422 | (and y (x-make-font-oblique y))))))) | |
423 | "Alist of font style vs function to generate a X font name of the style. | |
424 | The function is called with one argument, a font name.") | |
425 | ||
426 | (defcustom fontset-default-styles '(bold italic bold-italic) | |
427 | "List of alternative styles to create for a fontset. | |
428 | Valid elements include `bold', `demibold'; `italic', `oblique'; | |
429 | and combinations of one from each group, | |
430 | such as `bold-italic' and `demibold-oblique'." | |
431 | :group 'faces | |
01bc2c19 RS |
432 | :type '(set (const bold) (const demibold) (const italic) (const oblique) |
433 | (const bold-italic) (const bold-oblique) (const demibold-italic) | |
434 | (const demibold-oblique))) | |
d9691719 | 435 | |
bb98ead9 KH |
436 | (defun x-modify-font-name (fontname style) |
437 | "Substitute style specification part of FONTNAME for STYLE. | |
438 | STYLE should be listed in the variable `x-style-funcs-alist'." | |
439 | (let ((func (cdr (assq style x-style-funcs-alist)))) | |
440 | (if func | |
441 | (funcall func fontname)))) | |
35d4066a | 442 | |
ca1a6e9d | 443 | ;;;###autoload |
6fb8f8bd | 444 | (defun create-fontset-from-fontset-spec (fontset-spec |
bb98ead9 | 445 | &optional style-variant noerror) |
4ed46869 KH |
446 | "Create a fontset from fontset specification string FONTSET-SPEC. |
447 | FONTSET-SPEC is a string of the format: | |
448 | FONTSET-NAME,CHARSET-NAME0:FONT-NAME0,CHARSET-NAME1:FONT-NAME1, ... | |
494ec9bc | 449 | Any number of SPACE, TAB, and NEWLINE can be put before and after commas. |
bb98ead9 KH |
450 | |
451 | Optional 2nd argument STYLE-VARIANT is a list of font styles | |
452 | \(e.g. bold, italic) or the symbol t to specify all available styles. | |
453 | If this argument is specified, fontsets which differs from | |
454 | FONTSET-NAME in styles are also created. An element of STYLE-VARIANT | |
455 | may be cons of style and a font name. In this case, the style variant | |
456 | fontset uses the font for ASCII character set. | |
457 | ||
883e21bd KH |
458 | If this function attempts to create already existing fontset, error is |
459 | signaled unless the optional 3rd argument NOERROR is non-nil." | |
494ec9bc KH |
460 | (if (not (string-match "^[^,]+" fontset-spec)) |
461 | (error "Invalid fontset spec: %s" fontset-spec)) | |
462 | (let ((idx (match-end 0)) | |
463 | (name (match-string 0 fontset-spec)) | |
8f901917 | 464 | fontlist full-fontlist ascii-font resolved-ascii-font charset) |
6fb8f8bd KH |
465 | (if (query-fontset name) |
466 | (or noerror | |
467 | (error "Fontset \"%s\" already exists")) | |
468 | ;; At first, extract pairs of charset and fontname from FONTSET-SPEC. | |
469 | (while (string-match "[, \t\n]*\\([^:]+\\):\\([^,]+\\)" fontset-spec idx) | |
470 | (setq idx (match-end 0)) | |
471 | (setq charset (intern (match-string 1 fontset-spec))) | |
472 | (if (charsetp charset) | |
473 | (setq fontlist (cons (cons charset (match-string 2 fontset-spec)) | |
474 | fontlist)))) | |
bb98ead9 KH |
475 | ;; Remember the specified ASCII font name now because it will be |
476 | ;; replaced by resolved font name by x-complement-fontset-spec. | |
477 | (setq ascii-font (cdr (assq 'ascii fontlist))) | |
6fb8f8bd KH |
478 | |
479 | ;; If NAME conforms to XLFD, complement FONTLIST for charsets | |
480 | ;; which are not specified in FONTSET-SPEC. | |
bb98ead9 KH |
481 | (let ((fields (x-decompose-font-name name))) |
482 | (if fields | |
483 | (setq full-fontlist (x-complement-fontset-spec fields fontlist)))) | |
6fb8f8bd | 484 | |
bb98ead9 KH |
485 | (when full-fontlist |
486 | ;; Create the fontset. | |
487 | (new-fontset name full-fontlist) | |
488 | ||
489 | ;; Define aliases: short name (if appropriate) and ASCII font name. | |
490 | (if (and (string-match "fontset-.*$" name) | |
491 | (not (assoc name fontset-alias-alist))) | |
492 | (let ((alias (match-string 0 name))) | |
493 | (or (rassoc alias fontset-alias-alist) | |
494 | (setq fontset-alias-alist | |
495 | (cons (cons name alias) fontset-alias-alist))))) | |
8f901917 KH |
496 | (setq resolved-ascii-font (cdr (assq 'ascii full-fontlist))) |
497 | (setq fontset-alias-alist | |
498 | (cons (cons name resolved-ascii-font) | |
499 | fontset-alias-alist)) | |
500 | (or (equal ascii-font resolved-ascii-font) | |
501 | (setq fontset-alias-alist | |
502 | (cons (cons name ascii-font) | |
503 | fontset-alias-alist))) | |
bb98ead9 KH |
504 | |
505 | ;; At last, handle style variants. | |
506 | (if (eq style-variant t) | |
d9691719 | 507 | (setq style-variant fontset-default-styles)) |
bb98ead9 KH |
508 | |
509 | (if style-variant | |
510 | ;; Generate fontset names of style variants and set them | |
511 | ;; in uninstantiated-fontset-alist. | |
512 | (let* (nonascii-fontlist | |
513 | new-name new-ascii-font style font) | |
514 | (if ascii-font | |
515 | (setq nonascii-fontlist (delete (cons 'ascii ascii-font) | |
516 | (copy-sequence fontlist))) | |
517 | (setq ascii-font (cdr (assq 'ascii full-fontlist)) | |
518 | nonascii-fontlist fontlist)) | |
519 | (while style-variant | |
520 | (setq style (car style-variant)) | |
521 | (if (symbolp style) | |
522 | (setq font nil) | |
523 | (setq font (cdr style) | |
524 | style (car style))) | |
525 | (setq new-name (x-modify-font-name name style)) | |
526 | (when new-name | |
527 | ;; Modify ASCII font name for the style... | |
528 | (setq new-ascii-font | |
8f901917 KH |
529 | (or font |
530 | (x-modify-font-name resolved-ascii-font style))) | |
bb98ead9 KH |
531 | ;; but leave fonts for the other charsets unmodified |
532 | ;; for the momemnt. They are modified for the style | |
533 | ;; in instantiate-fontset. | |
534 | (setq uninstantiated-fontset-alist | |
535 | (cons (list new-name | |
536 | style | |
537 | (cons (cons 'ascii new-ascii-font) | |
538 | nonascii-fontlist)) | |
539 | uninstantiated-fontset-alist)) | |
540 | (setq fontset-alias-alist | |
541 | (cons (cons new-name new-ascii-font) | |
542 | fontset-alias-alist))) | |
543 | (setq style-variant (cdr style-variant))))))))) | |
4ed46869 | 544 | |
2725d3db | 545 | (defun instantiate-fontset (fontset) |
6fb8f8bd KH |
546 | "Make FONTSET be readly to use. |
547 | FONTSET should be in the variable `uninstantiated-fontset-alist' in advance. | |
35d4066a | 548 | Return FONTSET if it is created successfully, else return nil." |
2725d3db | 549 | (let ((fontset-data (assoc fontset uninstantiated-fontset-alist))) |
bb98ead9 KH |
550 | (when fontset-data |
551 | (setq uninstantiated-fontset-alist | |
552 | (delete fontset-data uninstantiated-fontset-alist)) | |
553 | ||
554 | (let* ((fields (x-decompose-font-name fontset)) | |
555 | (style (nth 1 fontset-data)) | |
556 | (fontlist (x-complement-fontset-spec fields (nth 2 fontset-data))) | |
557 | (font (cdr (assq 'ascii fontlist)))) | |
558 | ;; If ASCII font is available, instantiate this fontset. | |
35d4066a | 559 | (when font |
6fb8f8bd | 560 | (let ((new-fontlist (list (cons 'ascii font)))) |
bb98ead9 KH |
561 | ;; Fonts for non-ascii charsets should be modified for |
562 | ;; this style now. | |
6fb8f8bd KH |
563 | (while fontlist |
564 | (setq font (cdr (car fontlist))) | |
565 | (or (eq (car (car fontlist)) 'ascii) | |
bb98ead9 KH |
566 | (setq new-fontlist |
567 | (cons (cons (car (car fontlist)) | |
568 | (x-modify-font-name font style)) | |
569 | new-fontlist))) | |
6fb8f8bd | 570 | (setq fontlist (cdr fontlist))) |
bb98ead9 | 571 | (new-fontset fontset new-fontlist) |
6fb8f8bd | 572 | fontset)))))) |
bb98ead9 KH |
573 | |
574 | (defun resolve-fontset-name (pattern) | |
575 | "Return a fontset name matching PATTERN." | |
576 | (let ((fontset (car (rassoc pattern fontset-alias-alist)))) | |
577 | (or fontset (setq fontset pattern)) | |
578 | (if (assoc fontset uninstantiated-fontset-alist) | |
579 | (instantiate-fontset fontset) | |
580 | (query-fontset fontset)))) | |
4ed46869 | 581 | \f |
acfb10b8 | 582 | ;; Create standard fontset from 16 dots fonts which are the most widely |
80d4ea92 KH |
583 | ;; installed fonts. Fonts for Chinese-GB, Korean, and Chinese-CNS are |
584 | ;; specified here because FAMILY of those fonts are not "fixed" in | |
585 | ;; many cases. | |
acfb10b8 KH |
586 | (defvar standard-fontset-spec |
587 | "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard, | |
4ed46869 KH |
588 | chinese-gb2312:-*-medium-r-normal-*-16-*-gb2312*-*, |
589 | korean-ksc5601:-*-medium-r-normal-*-16-*-ksc5601*-*, | |
590 | chinese-cns11643-1:-*-medium-r-normal-*-16-*-cns11643*-1, | |
591 | chinese-cns11643-2:-*-medium-r-normal-*-16-*-cns11643*-2, | |
592 | chinese-cns11643-3:-*-medium-r-normal-*-16-*-cns11643*-3, | |
593 | chinese-cns11643-4:-*-medium-r-normal-*-16-*-cns11643*-4, | |
594 | chinese-cns11643-5:-*-medium-r-normal-*-16-*-cns11643*-5, | |
595 | chinese-cns11643-6:-*-medium-r-normal-*-16-*-cns11643*-6, | |
596 | chinese-cns11643-7:-*-medium-r-normal-*-16-*-cns11643*-7" | |
acfb10b8 KH |
597 | "String of fontset spec of the standard fontset. |
598 | You have the biggest chance to display international characters | |
599 | with correct glyphs by using the standard fontset. | |
4ed46869 KH |
600 | See the documentation of `create-fontset-from-fontset-spec' for the format.") |
601 | ||
602 | ;; Create fontsets from X resources of the name `fontset-N (class | |
603 | ;; Fontset-N)' where N is integer 0, 1, ... | |
604 | ;; The values of the resources the string of the same format as | |
acfb10b8 | 605 | ;; `standard-fontset-spec'. |
4ed46869 KH |
606 | |
607 | (defun create-fontset-from-x-resource () | |
608 | (let ((idx 0) | |
609 | fontset-spec) | |
610 | (while (setq fontset-spec (x-get-resource (concat "fontset-" idx) | |
611 | (concat "Fontset-" idx))) | |
b65976cb | 612 | (create-fontset-from-fontset-spec fontset-spec nil 'noerror) |
4ed46869 KH |
613 | (setq idx (1+ idx))))) |
614 | ||
615 | (defsubst fontset-list () | |
616 | "Returns a list of all defined fontset names." | |
617 | (mapcar 'car global-fontset-alist)) | |
618 | ||
619 | ;; | |
620 | (provide 'fontset) | |
621 | ||
622 | ;;; fontset.el ends here |