Commit | Line | Data |
---|---|---|
4ed46869 | 1 | /* Fontset handler. |
0d407d77 | 2 | Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN. |
75c8c592 | 3 | Licensed to the Free Software Foundation. |
06f76f0d KH |
4 | Copyright (C) 2001, 2002 |
5 | National Institute of Advanced Industrial Science and Technology (AIST) | |
6 | Registration Number H13PRO009 | |
4ed46869 | 7 | |
369314dc KH |
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. | |
4ed46869 | 14 | |
369314dc KH |
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. | |
4ed46869 | 19 | |
369314dc KH |
20 | You should have received a copy of the GNU General Public License |
21 | along with GNU Emacs; see the file COPYING. If not, write to | |
22 | the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | Boston, MA 02111-1307, USA. */ | |
4ed46869 | 24 | |
0d407d77 KH |
25 | /* #define FONTSET_DEBUG */ |
26 | ||
4ed46869 | 27 | #include <config.h> |
0d407d77 KH |
28 | |
29 | #ifdef FONTSET_DEBUG | |
30 | #include <stdio.h> | |
31 | #endif | |
32 | ||
4ed46869 | 33 | #include "lisp.h" |
06f76f0d | 34 | #include "blockinput.h" |
1ff005e1 | 35 | #include "buffer.h" |
06f76f0d | 36 | #include "character.h" |
4ed46869 KH |
37 | #include "charset.h" |
38 | #include "ccl.h" | |
2538fae4 | 39 | #include "keyboard.h" |
4ed46869 | 40 | #include "frame.h" |
0d407d77 | 41 | #include "dispextern.h" |
3541bb8f | 42 | #include "fontset.h" |
0d407d77 KH |
43 | #include "window.h" |
44 | ||
45 | #ifdef FONTSET_DEBUG | |
46 | #undef xassert | |
47 | #define xassert(X) do {if (!(X)) abort ();} while (0) | |
48 | #undef INLINE | |
49 | #define INLINE | |
50 | #endif | |
51 | ||
52 | ||
53 | /* FONTSET | |
54 | ||
55 | A fontset is a collection of font related information to give | |
06f76f0d KH |
56 | similar appearance (style, etc) of characters. There are two kinds |
57 | of fontsets; base and realized. A base fontset is created by | |
58 | `new-fontset' from Emacs Lisp explicitly. A realized fontset is | |
0d407d77 | 59 | created implicitly when a face is realized for ASCII characters. A |
06f76f0d KH |
60 | face is also realized for non-ASCII characters based on an ASCII |
61 | face. All of non-ASCII faces based on the same ASCII face share | |
62 | the same realized fontset. | |
63 | ||
64 | A fontset object is implemented by a char-table whose default value | |
65 | and parent are always nil. | |
fc8865fc | 66 | |
06f76f0d KH |
67 | An element of a base fontset is a font specification of the form: |
68 | [ FAMILY WEIGHT SLANT SWIDTH REGISTRY ] (vector of size 5) | |
69 | or | |
70 | FONT-NAME (strig) | |
0d407d77 | 71 | |
06f76f0d | 72 | FAMILY and REGISTRY are strings. |
0d407d77 | 73 | |
06f76f0d KH |
74 | WEIGHT, SLANT, and SWIDTH must be symbols that set-face-attribute |
75 | accepts as attribute values for :weight, :slant, :swidth | |
76 | respectively. | |
0d407d77 | 77 | |
0d407d77 | 78 | |
06f76f0d | 79 | A fontset has 7 extra slots. |
0d407d77 KH |
80 | |
81 | The 1st slot is an ID number of the fontset. | |
82 | ||
06f76f0d KH |
83 | The 2nd slot is a name of the fontset in a base fontset, and nil in |
84 | a realized fontset. | |
85 | ||
86 | The 3rd slot is nil in a base fontset, and a base fontset in a | |
87 | realized fontset. | |
88 | ||
89 | The 4th slot is a frame that the fontset belongs to. This is nil | |
90 | in a base fontset. | |
91 | ||
92 | The 5th slot is a cons of 0 and fontname for ASCII characters in a | |
93 | base fontset, and nil in a realized face. | |
0d407d77 | 94 | |
06f76f0d KH |
95 | The 6th slot is an alist of a charset vs. the corresponding font |
96 | specification. | |
0d407d77 | 97 | |
06f76f0d KH |
98 | The 7th slot is an alist of a font specification vs. the |
99 | corresponding face ID. In a base fontset, the face IDs are all | |
100 | nil. | |
0d407d77 | 101 | |
afe93d01 | 102 | All fontsets are recorded in Vfontset_table. |
0d407d77 KH |
103 | |
104 | ||
105 | DEFAULT FONTSET | |
106 | ||
06f76f0d KH |
107 | There's a special fontset named `default fontset' which defines the |
108 | default font specifications. When a base fontset doesn't specify a | |
afe93d01 KH |
109 | font for a specific character, the corresponding value in the |
110 | default fontset is used. The format is the same as a base fontset. | |
0d407d77 | 111 | |
afe93d01 KH |
112 | The parent of a realized fontset created for such a face that has |
113 | no fontset is the default fontset. | |
0d407d77 KH |
114 | |
115 | ||
116 | These structures are hidden from the other codes than this file. | |
117 | The other codes handle fontsets only by their ID numbers. They | |
06f76f0d KH |
118 | usually use the variable name `fontset' for IDs. But, in this |
119 | file, we always use varialbe name `id' for IDs, and name `fontset' | |
120 | for the actual fontset objects (i.e. char-table objects). | |
0d407d77 KH |
121 | |
122 | */ | |
123 | ||
124 | /********** VARIABLES and FUNCTION PROTOTYPES **********/ | |
125 | ||
126 | extern Lisp_Object Qfont; | |
127 | Lisp_Object Qfontset; | |
128 | ||
129 | /* Vector containing all fontsets. */ | |
130 | static Lisp_Object Vfontset_table; | |
131 | ||
fc8865fc | 132 | /* Next possibly free fontset ID. Usually this keeps the minimum |
0d407d77 KH |
133 | fontset ID not yet used. */ |
134 | static int next_fontset_id; | |
135 | ||
136 | /* The default fontset. This gives default FAMILY and REGISTRY of | |
06f76f0d | 137 | font for each character. */ |
0d407d77 | 138 | static Lisp_Object Vdefault_fontset; |
4ed46869 | 139 | |
4ed46869 | 140 | Lisp_Object Vfont_encoding_alist; |
6a7e6d80 | 141 | Lisp_Object Vuse_default_ascent; |
2aeafb78 | 142 | Lisp_Object Vignore_relative_composition; |
01d4b817 | 143 | Lisp_Object Valternate_fontname_alist; |
1c283e35 | 144 | Lisp_Object Vfontset_alias_alist; |
810abb87 | 145 | Lisp_Object Vvertical_centering_font_regexp; |
4ed46869 | 146 | |
0d407d77 KH |
147 | /* The following six are declarations of callback functions depending |
148 | on window system. See the comments in src/fontset.h for more | |
149 | detail. */ | |
4ed46869 KH |
150 | |
151 | /* Return a pointer to struct font_info of font FONT_IDX of frame F. */ | |
5771dcf4 | 152 | struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx)); |
4ed46869 | 153 | |
fc8865fc PJ |
154 | /* Return a list of font names which matches PATTERN. See the documentation |
155 | of `x-list-fonts' for more details. */ | |
3541bb8f KH |
156 | Lisp_Object (*list_fonts_func) P_ ((struct frame *f, |
157 | Lisp_Object pattern, | |
158 | int size, | |
159 | int maxnames)); | |
4ed46869 KH |
160 | |
161 | /* Load a font named NAME for frame F and return a pointer to the | |
162 | information of the loaded font. If loading is failed, return 0. */ | |
5771dcf4 | 163 | struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int)); |
4ed46869 KH |
164 | |
165 | /* Return a pointer to struct font_info of a font named NAME for frame F. */ | |
5771dcf4 | 166 | struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name)); |
4ed46869 KH |
167 | |
168 | /* Additional function for setting fontset or changing fontset | |
169 | contents of frame F. */ | |
5771dcf4 AS |
170 | void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg, |
171 | Lisp_Object oldval)); | |
4ed46869 | 172 | |
727fb790 KH |
173 | /* To find a CCL program, fs_load_font calls this function. |
174 | The argument is a pointer to the struct font_info. | |
fc8865fc | 175 | This function set the member `encoder' of the structure. */ |
727fb790 KH |
176 | void (*find_ccl_program_func) P_ ((struct font_info *)); |
177 | ||
4ed46869 | 178 | /* Check if any window system is used now. */ |
5771dcf4 | 179 | void (*check_window_system_func) P_ ((void)); |
4ed46869 | 180 | |
0d407d77 KH |
181 | |
182 | /* Prototype declarations for static functions. */ | |
0d407d77 KH |
183 | static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); |
184 | static int fontset_id_valid_p P_ ((int)); | |
185 | static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object)); | |
0d407d77 KH |
186 | |
187 | \f | |
188 | /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/ | |
189 | ||
0d407d77 KH |
190 | /* Return the fontset with ID. No check of ID's validness. */ |
191 | #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id) | |
192 | ||
afe93d01 | 193 | /* Macros to access special values of FONTSET. */ |
0d407d77 | 194 | #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0] |
06f76f0d KH |
195 | |
196 | /* Macros to access special values of (base) FONTSET. */ | |
0d407d77 | 197 | #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1] |
06f76f0d KH |
198 | #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4] |
199 | ||
200 | #define BASE_FONTSET_P(fontset) STRINGP (FONTSET_NAME (fontset)) | |
0d407d77 | 201 | |
06f76f0d KH |
202 | /* Macros to access special values of (realized) FONTSET. */ |
203 | #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2] | |
204 | #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3] | |
205 | #define FONTSET_CHARSET_ALIST(fontset) XCHAR_TABLE (fontset)->extras[5] | |
206 | #define FONTSET_FACE_ALIST(fontset) XCHAR_TABLE (fontset)->extras[6] | |
0d407d77 KH |
207 | |
208 | ||
209 | /* Return the element of FONTSET (char-table) at index C (character). */ | |
210 | ||
06f76f0d | 211 | #define FONTSET_REF(fontset, c, etl) ((elt) = fontset_ref ((fontset), (c))) |
0d407d77 | 212 | |
afe93d01 | 213 | static Lisp_Object |
0d407d77 KH |
214 | fontset_ref (fontset, c) |
215 | Lisp_Object fontset; | |
216 | int c; | |
217 | { | |
06f76f0d KH |
218 | Lisp_Object elt; |
219 | ||
220 | while (1) | |
221 | { | |
222 | elt = CHAR_TABLE_REF (fontset, c); | |
223 | if (NILP (elt) && ASCII_CHAR_P (c)) | |
224 | elt = FONTSET_ASCII (fontset); | |
225 | if (NILP (elt)) | |
226 | { | |
227 | Lisp_Object tail; | |
228 | struct charset *charset; | |
229 | ||
230 | for (tail = FONTSET_CHARSET_ALIST (fontset); | |
231 | CONSP (tail); tail = XCDR (tail)) | |
232 | { | |
233 | charset = CHARSET_FROM_ID (XCAR (XCAR (tail))); | |
234 | if (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)) | |
235 | { | |
236 | elt = XCDR (XCAR (tail)); | |
237 | break; | |
238 | } | |
239 | } | |
240 | } | |
241 | if (! NILP (elt) || EQ (fontset, Vdefault_fontset)) | |
242 | break; | |
243 | fontset = Vdefault_fontset; | |
244 | } | |
0d407d77 KH |
245 | return elt; |
246 | } | |
247 | ||
248 | ||
06f76f0d KH |
249 | /* Set the element of FONTSET at index IDX to the value ELT. IDX may |
250 | be a character or a charset. */ | |
0d407d77 | 251 | |
06f76f0d | 252 | #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt) |
0d407d77 | 253 | |
06f76f0d KH |
254 | static void |
255 | fontset_set (fontset, idx, elt) | |
256 | Lisp_Object fontset, idx, elt; | |
257 | { | |
258 | if (SYMBOLP (idx)) | |
259 | { | |
260 | Lisp_Object id, slot, tail; | |
261 | ||
262 | id = make_number (CHARSET_SYMBOL_ID (idx)); | |
263 | if (id == charset_ascii) | |
264 | Fset_char_table_range (fontset, | |
265 | Fcons (make_number (0), make_number (127)), | |
266 | elt); | |
267 | else | |
268 | { | |
269 | slot = Fassq (id, FONTSET_CHARSET_ALIST (fontset)); | |
270 | if (CONSP (slot)) | |
271 | XCDR (slot) = elt; | |
272 | else if (CONSP (FONTSET_CHARSET_ALIST (fontset))) | |
273 | { | |
274 | for (tail = FONTSET_CHARSET_ALIST (fontset); | |
275 | CONSP (XCDR (tail)); tail = XCDR (tail)); | |
276 | XCDR (tail) = Fcons (Fcons (id, elt), Qnil); | |
277 | } | |
278 | else | |
279 | FONTSET_CHARSET_ALIST (fontset) = Fcons (Fcons (id, elt), Qnil); | |
280 | } | |
281 | } | |
282 | else | |
283 | { | |
284 | int from = XINT (XCAR (idx)); | |
285 | int to = XINT (XCDR (idx)); | |
0d407d77 | 286 | |
06f76f0d KH |
287 | if (from == to) |
288 | CHAR_TABLE_SET (fontset, from, elt); | |
289 | else | |
290 | Fset_char_table_range (fontset, idx, elt); | |
291 | } | |
0d407d77 KH |
292 | } |
293 | ||
294 | ||
06f76f0d KH |
295 | /* Return a face registerd in the realized fontset FONTSET for the |
296 | character C. Return -1 if a face ID is not yet set. */ | |
0d407d77 | 297 | |
06f76f0d KH |
298 | static struct face * |
299 | fontset_face (fontset, c) | |
0d407d77 KH |
300 | Lisp_Object fontset; |
301 | int c; | |
0d407d77 | 302 | { |
06f76f0d KH |
303 | Lisp_Object base, elt; |
304 | int id; | |
305 | struct face *face; | |
0d407d77 | 306 | |
06f76f0d KH |
307 | base = FONTSET_BASE (fontset); |
308 | FONTSET_REF (base, c, elt); | |
0d407d77 | 309 | |
06f76f0d KH |
310 | if (NILP (elt)) |
311 | return NULL; | |
312 | ||
313 | elt = Fassoc (elt, FONTSET_FACE_ALIST (fontset)); | |
314 | if (! CONSP (elt)) | |
315 | return NULL; | |
316 | id = XINT (XCDR (elt)); | |
317 | face = FACE_FROM_ID (XFRAME (FONTSET_FRAME (fontset)), id); | |
318 | return face; | |
0d407d77 KH |
319 | } |
320 | ||
321 | ||
322 | /* Return a newly created fontset with NAME. If BASE is nil, make a | |
06f76f0d | 323 | base fontset. Otherwise make a realized fontset whose base is |
0d407d77 KH |
324 | BASE. */ |
325 | ||
326 | static Lisp_Object | |
327 | make_fontset (frame, name, base) | |
328 | Lisp_Object frame, name, base; | |
4ed46869 | 329 | { |
1337ac77 | 330 | Lisp_Object fontset; |
0d407d77 KH |
331 | int size = ASIZE (Vfontset_table); |
332 | int id = next_fontset_id; | |
0d407d77 KH |
333 | |
334 | /* Find a free slot in Vfontset_table. Usually, next_fontset_id is | |
335 | the next available fontset ID. So it is expected that this loop | |
336 | terminates quickly. In addition, as the last element of | |
fc8865fc | 337 | Vfontset_table is always nil, we don't have to check the range of |
0d407d77 KH |
338 | id. */ |
339 | while (!NILP (AREF (Vfontset_table, id))) id++; | |
340 | ||
341 | if (id + 1 == size) | |
342 | { | |
343 | Lisp_Object tem; | |
fc8865fc | 344 | int i; |
4ed46869 | 345 | |
06f76f0d | 346 | tem = Fmake_vector (make_number (size + 32), Qnil); |
0d407d77 KH |
347 | for (i = 0; i < size; i++) |
348 | AREF (tem, i) = AREF (Vfontset_table, i); | |
349 | Vfontset_table = tem; | |
350 | } | |
4ed46869 | 351 | |
11d9bd93 | 352 | fontset = Fmake_char_table (Qfontset, Qnil); |
0d407d77 KH |
353 | |
354 | FONTSET_ID (fontset) = make_number (id); | |
06f76f0d KH |
355 | if (NILP (base)) |
356 | { | |
357 | FONTSET_NAME (fontset) = name; | |
358 | } | |
359 | else | |
360 | { | |
361 | FONTSET_NAME (fontset) = Qnil; | |
362 | FONTSET_FRAME (fontset) = frame; | |
363 | FONTSET_BASE (fontset) = base; | |
364 | } | |
0d407d77 | 365 | |
06f76f0d | 366 | ASET (Vfontset_table, id, fontset); |
0d407d77 KH |
367 | next_fontset_id = id + 1; |
368 | return fontset; | |
4ed46869 KH |
369 | } |
370 | ||
0d407d77 | 371 | |
0d407d77 | 372 | \f |
fc8865fc | 373 | /********** INTERFACES TO xfaces.c and dispextern.h **********/ |
0d407d77 KH |
374 | |
375 | /* Return name of the fontset with ID. */ | |
376 | ||
377 | Lisp_Object | |
378 | fontset_name (id) | |
379 | int id; | |
380 | { | |
381 | Lisp_Object fontset; | |
06f76f0d | 382 | |
0d407d77 KH |
383 | fontset = FONTSET_FROM_ID (id); |
384 | return FONTSET_NAME (fontset); | |
385 | } | |
386 | ||
387 | ||
388 | /* Return ASCII font name of the fontset with ID. */ | |
389 | ||
390 | Lisp_Object | |
391 | fontset_ascii (id) | |
392 | int id; | |
393 | { | |
06f76f0d KH |
394 | Lisp_Object fontset; |
395 | ||
0d407d77 | 396 | fontset= FONTSET_FROM_ID (id); |
06f76f0d | 397 | return FONTSET_ASCII (fontset); |
0d407d77 KH |
398 | } |
399 | ||
400 | ||
06f76f0d KH |
401 | /* Free fontset of FACE defined on frame F. Called from |
402 | free_realized_face. */ | |
0d407d77 | 403 | |
4ed46869 | 404 | void |
0d407d77 KH |
405 | free_face_fontset (f, face) |
406 | FRAME_PTR f; | |
407 | struct face *face; | |
4ed46869 | 408 | { |
06f76f0d KH |
409 | AREF (Vfontset_table, face->fontset) = Qnil; |
410 | if (face->fontset < next_fontset_id) | |
411 | next_fontset_id = face->fontset; | |
0d407d77 | 412 | } |
18998710 | 413 | |
0d407d77 KH |
414 | |
415 | /* Return 1 iff FACE is suitable for displaying character C. | |
416 | Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P | |
06f76f0d | 417 | when C is not an ASCII character. */ |
0d407d77 KH |
418 | |
419 | int | |
420 | face_suitable_for_char_p (face, c) | |
421 | struct face *face; | |
422 | int c; | |
423 | { | |
06f76f0d | 424 | Lisp_Object fontset; |
0d407d77 | 425 | |
0d407d77 | 426 | fontset = FONTSET_FROM_ID (face->fontset); |
06f76f0d | 427 | return (face == fontset_face (fontset, c)); |
0d407d77 KH |
428 | } |
429 | ||
430 | ||
431 | /* Return ID of face suitable for displaying character C on frame F. | |
432 | The selection of face is done based on the fontset of FACE. FACE | |
06f76f0d KH |
433 | must be reazlied for ASCII characters in advance. Called from the |
434 | macro FACE_FOR_CHAR when C is not an ASCII character. */ | |
0d407d77 KH |
435 | |
436 | int | |
437 | face_for_char (f, face, c) | |
438 | FRAME_PTR f; | |
439 | struct face *face; | |
440 | int c; | |
441 | { | |
442 | Lisp_Object fontset, elt; | |
06f76f0d | 443 | struct face *new_face; |
0d407d77 KH |
444 | |
445 | xassert (fontset_id_valid_p (face->fontset)); | |
446 | fontset = FONTSET_FROM_ID (face->fontset); | |
447 | xassert (!BASE_FONTSET_P (fontset)); | |
448 | ||
06f76f0d KH |
449 | new_face = fontset_face (fontset, c); |
450 | if (new_face) | |
451 | return new_face->id; | |
0d407d77 KH |
452 | |
453 | /* No face is recorded for C in the fontset of FACE. Make a new | |
454 | realized face for C that has the same fontset. */ | |
06f76f0d | 455 | return lookup_face (f, face->lface, c, face); |
0d407d77 KH |
456 | } |
457 | ||
458 | ||
459 | /* Make a realized fontset for ASCII face FACE on frame F from the | |
460 | base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the | |
461 | default fontset as the base. Value is the id of the new fontset. | |
462 | Called from realize_x_face. */ | |
463 | ||
464 | int | |
465 | make_fontset_for_ascii_face (f, base_fontset_id) | |
466 | FRAME_PTR f; | |
467 | int base_fontset_id; | |
468 | { | |
1337ac77 | 469 | Lisp_Object base_fontset, fontset, frame; |
0d407d77 KH |
470 | |
471 | XSETFRAME (frame, f); | |
472 | if (base_fontset_id >= 0) | |
473 | { | |
474 | base_fontset = FONTSET_FROM_ID (base_fontset_id); | |
475 | if (!BASE_FONTSET_P (base_fontset)) | |
476 | base_fontset = FONTSET_BASE (base_fontset); | |
477 | xassert (BASE_FONTSET_P (base_fontset)); | |
4ed46869 | 478 | } |
0d407d77 KH |
479 | else |
480 | base_fontset = Vdefault_fontset; | |
481 | ||
482 | fontset = make_fontset (frame, Qnil, base_fontset); | |
f3231837 | 483 | return XINT (FONTSET_ID (fontset)); |
0d407d77 KH |
484 | } |
485 | ||
486 | ||
06f76f0d KH |
487 | /* Return FONT-SPEC recorded in the fontset of FACE for character C. |
488 | If FACE is null, or the fontset doesn't contain information about | |
489 | C, get the font name pattern from the default fontset. Called from | |
490 | choose_face_font. */ | |
0d407d77 KH |
491 | |
492 | Lisp_Object | |
06f76f0d | 493 | fontset_font_pattern (f, face, c) |
0d407d77 | 494 | FRAME_PTR f; |
06f76f0d KH |
495 | struct face *face; |
496 | int c; | |
0d407d77 | 497 | { |
06f76f0d KH |
498 | Lisp_Object fontset, base, elt; |
499 | int id = face ? face->fontset : -1; | |
fc8865fc | 500 | |
06f76f0d | 501 | if (id >= 0) |
0d407d77 KH |
502 | { |
503 | fontset = FONTSET_FROM_ID (id); | |
504 | xassert (!BASE_FONTSET_P (fontset)); | |
06f76f0d KH |
505 | base = FONTSET_BASE (fontset); |
506 | } | |
507 | else | |
508 | { | |
509 | base = Vdefault_fontset; | |
0d407d77 | 510 | } |
4ed46869 | 511 | |
06f76f0d KH |
512 | FONTSET_REF (base, c, elt); |
513 | if (face && ! NILP (elt)) | |
514 | { | |
515 | Lisp_Object slot; | |
516 | ||
517 | slot = Fassoc (elt, FONTSET_FACE_ALIST (fontset)); | |
518 | if (CONSP (slot)) | |
519 | XSETCDR (slot, make_number (face->id)); | |
520 | FONTSET_FACE_ALIST (fontset) | |
521 | = Fcons (Fcons (elt, make_number (face->id)), | |
522 | FONTSET_FACE_ALIST (fontset)); | |
523 | } | |
524 | return elt; | |
4ed46869 KH |
525 | } |
526 | ||
d5e7d534 | 527 | |
97f4db8c AI |
528 | #if defined(WINDOWSNT) && defined (_MSC_VER) |
529 | #pragma optimize("", off) | |
530 | #endif | |
531 | ||
06f76f0d KH |
532 | /* Load a font named FONTNAME on frame F. Return a pointer to the |
533 | struct font_info of the loaded font. If loading fails, return | |
534 | NULL. */ | |
4ed46869 KH |
535 | |
536 | struct font_info * | |
06f76f0d | 537 | fs_load_font (f, fontname) |
4ed46869 | 538 | FRAME_PTR f; |
4ed46869 KH |
539 | char *fontname; |
540 | { | |
06f76f0d | 541 | Lisp_Object tail, elt; |
4ed46869 | 542 | struct font_info *fontp; |
4ed46869 | 543 | |
0d407d77 KH |
544 | if (!fontname) |
545 | /* No way to get fontname. */ | |
546 | return 0; | |
4ed46869 | 547 | |
06f76f0d | 548 | fontp = (*load_font_func) (f, fontname, 0); |
4ed46869 | 549 | if (!fontp) |
06f76f0d | 550 | return NULL; |
4ed46869 | 551 | |
0d407d77 KH |
552 | /* Fill in members (charset, vertical_centering, encoding, etc) of |
553 | font_info structure that are not set by (*load_font_func). */ | |
06f76f0d KH |
554 | for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail)) |
555 | { | |
556 | elt = XCAR (tail); | |
557 | if (STRINGP (XCAR (elt)) && CHARSETP (XCDR (elt)) | |
558 | && fast_c_string_match_ignore_case (XCAR (elt), fontname) >= 0) | |
559 | { | |
560 | fontp->charset = CHARSET_SYMBOL_ID (XCDR (elt)); | |
561 | break; | |
562 | } | |
563 | } | |
564 | if (! CONSP (tail)) | |
565 | return NULL; | |
4ed46869 | 566 | |
810abb87 KH |
567 | fontp->vertical_centering |
568 | = (STRINGP (Vvertical_centering_font_regexp) | |
fc8865fc | 569 | && (fast_c_string_match_ignore_case |
810abb87 KH |
570 | (Vvertical_centering_font_regexp, fontp->full_name) >= 0)); |
571 | ||
06f76f0d | 572 | fontp->font_encoder = NULL; |
727fb790 KH |
573 | |
574 | if (find_ccl_program_func) | |
575 | (*find_ccl_program_func) (fontp); | |
4ed46869 | 576 | |
4ed46869 KH |
577 | return fontp; |
578 | } | |
579 | ||
97f4db8c AI |
580 | #if defined(WINDOWSNT) && defined (_MSC_VER) |
581 | #pragma optimize("", on) | |
582 | #endif | |
583 | ||
0d407d77 | 584 | \f |
4ed46869 KH |
585 | /* Cache data used by fontset_pattern_regexp. The car part is a |
586 | pattern string containing at least one wild card, the cdr part is | |
587 | the corresponding regular expression. */ | |
588 | static Lisp_Object Vcached_fontset_data; | |
589 | ||
7539e11f KR |
590 | #define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data) |
591 | #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data)) | |
4ed46869 KH |
592 | |
593 | /* If fontset name PATTERN contains any wild card, return regular | |
594 | expression corresponding to PATTERN. */ | |
595 | ||
0d407d77 | 596 | static Lisp_Object |
4ed46869 KH |
597 | fontset_pattern_regexp (pattern) |
598 | Lisp_Object pattern; | |
599 | { | |
4ed46869 KH |
600 | if (!index (XSTRING (pattern)->data, '*') |
601 | && !index (XSTRING (pattern)->data, '?')) | |
602 | /* PATTERN does not contain any wild cards. */ | |
1c283e35 | 603 | return Qnil; |
4ed46869 KH |
604 | |
605 | if (!CONSP (Vcached_fontset_data) | |
606 | || strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME)) | |
607 | { | |
608 | /* We must at first update the cached data. */ | |
5604ec34 | 609 | char *regex = (char *) alloca (XSTRING (pattern)->size * 2 + 3); |
4ed46869 KH |
610 | char *p0, *p1 = regex; |
611 | ||
1c283e35 KH |
612 | /* Convert "*" to ".*", "?" to ".". */ |
613 | *p1++ = '^'; | |
ea5239ec | 614 | for (p0 = (char *) XSTRING (pattern)->data; *p0; p0++) |
4ed46869 | 615 | { |
1c283e35 | 616 | if (*p0 == '*') |
4ed46869 | 617 | { |
1c283e35 KH |
618 | *p1++ = '.'; |
619 | *p1++ = '*'; | |
4ed46869 | 620 | } |
1c283e35 | 621 | else if (*p0 == '?') |
d96d677d | 622 | *p1++ = '.'; |
1c283e35 KH |
623 | else |
624 | *p1++ = *p0; | |
4ed46869 KH |
625 | } |
626 | *p1++ = '$'; | |
627 | *p1++ = 0; | |
628 | ||
629 | Vcached_fontset_data = Fcons (build_string (XSTRING (pattern)->data), | |
630 | build_string (regex)); | |
631 | } | |
632 | ||
633 | return CACHED_FONTSET_REGEX; | |
634 | } | |
635 | ||
0d407d77 KH |
636 | /* Return ID of the base fontset named NAME. If there's no such |
637 | fontset, return -1. */ | |
638 | ||
639 | int | |
640 | fs_query_fontset (name, regexpp) | |
641 | Lisp_Object name; | |
642 | int regexpp; | |
643 | { | |
1337ac77 | 644 | Lisp_Object tem; |
0d407d77 KH |
645 | int i; |
646 | ||
647 | name = Fdowncase (name); | |
648 | if (!regexpp) | |
649 | { | |
650 | tem = Frassoc (name, Vfontset_alias_alist); | |
651 | if (CONSP (tem) && STRINGP (XCAR (tem))) | |
652 | name = XCAR (tem); | |
653 | else | |
654 | { | |
655 | tem = fontset_pattern_regexp (name); | |
656 | if (STRINGP (tem)) | |
657 | { | |
658 | name = tem; | |
659 | regexpp = 1; | |
660 | } | |
661 | } | |
662 | } | |
663 | ||
664 | for (i = 0; i < ASIZE (Vfontset_table); i++) | |
665 | { | |
666 | Lisp_Object fontset; | |
667 | unsigned char *this_name; | |
668 | ||
669 | fontset = FONTSET_FROM_ID (i); | |
670 | if (NILP (fontset) | |
671 | || !BASE_FONTSET_P (fontset)) | |
672 | continue; | |
673 | ||
674 | this_name = XSTRING (FONTSET_NAME (fontset))->data; | |
675 | if (regexpp | |
676 | ? fast_c_string_match_ignore_case (name, this_name) >= 0 | |
677 | : !strcmp (XSTRING (name)->data, this_name)) | |
678 | return i; | |
679 | } | |
680 | return -1; | |
681 | } | |
682 | ||
683 | ||
727fb790 | 684 | DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0, |
335c5470 PJ |
685 | doc: /* Return the name of a fontset that matches PATTERN. |
686 | The value is nil if there is no matching fontset. | |
687 | PATTERN can contain `*' or `?' as a wildcard | |
688 | just as X font name matching algorithm allows. | |
689 | If REGEXPP is non-nil, PATTERN is a regular expression. */) | |
690 | (pattern, regexpp) | |
727fb790 | 691 | Lisp_Object pattern, regexpp; |
4ed46869 | 692 | { |
0d407d77 KH |
693 | Lisp_Object fontset; |
694 | int id; | |
4ed46869 KH |
695 | |
696 | (*check_window_system_func) (); | |
697 | ||
b7826503 | 698 | CHECK_STRING (pattern); |
4ed46869 KH |
699 | |
700 | if (XSTRING (pattern)->size == 0) | |
701 | return Qnil; | |
702 | ||
0d407d77 KH |
703 | id = fs_query_fontset (pattern, !NILP (regexpp)); |
704 | if (id < 0) | |
705 | return Qnil; | |
4ed46869 | 706 | |
0d407d77 KH |
707 | fontset = FONTSET_FROM_ID (id); |
708 | return FONTSET_NAME (fontset); | |
4ed46869 KH |
709 | } |
710 | ||
06f76f0d | 711 | /* Return a list of base fontset names matching PATTERN on frame F. */ |
4ed46869 KH |
712 | |
713 | Lisp_Object | |
714 | list_fontsets (f, pattern, size) | |
715 | FRAME_PTR f; | |
716 | Lisp_Object pattern; | |
717 | int size; | |
718 | { | |
1337ac77 | 719 | Lisp_Object frame, regexp, val; |
0d407d77 | 720 | int id; |
4ed46869 | 721 | |
0d407d77 | 722 | XSETFRAME (frame, f); |
4ed46869 | 723 | |
0d407d77 | 724 | regexp = fontset_pattern_regexp (pattern); |
4ed46869 | 725 | val = Qnil; |
4ed46869 | 726 | |
0d407d77 KH |
727 | for (id = 0; id < ASIZE (Vfontset_table); id++) |
728 | { | |
729 | Lisp_Object fontset; | |
730 | unsigned char *name; | |
731 | ||
732 | fontset = FONTSET_FROM_ID (id); | |
733 | if (NILP (fontset) | |
734 | || !BASE_FONTSET_P (fontset) | |
735 | || !EQ (frame, FONTSET_FRAME (fontset))) | |
736 | continue; | |
737 | name = XSTRING (FONTSET_NAME (fontset))->data; | |
738 | ||
739 | if (!NILP (regexp) | |
740 | ? (fast_c_string_match_ignore_case (regexp, name) < 0) | |
741 | : strcmp (XSTRING (pattern)->data, name)) | |
742 | continue; | |
743 | ||
0d407d77 | 744 | val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val); |
4ed46869 KH |
745 | } |
746 | ||
747 | return val; | |
748 | } | |
749 | ||
4ed46869 | 750 | |
06f76f0d | 751 | /* Free all realized fontsets whose base fontset is BASE. */ |
4ed46869 | 752 | |
06f76f0d KH |
753 | static void |
754 | free_realized_fontsets (base) | |
755 | Lisp_Object base; | |
756 | { | |
757 | int id; | |
4ed46869 | 758 | |
06f76f0d KH |
759 | BLOCK_INPUT; |
760 | for (id = 0; id < ASIZE (Vfontset_table); id++) | |
4ed46869 | 761 | { |
06f76f0d | 762 | Lisp_Object this = AREF (Vfontset_table, id); |
4ed46869 | 763 | |
06f76f0d | 764 | if (EQ (FONTSET_BASE (this), base)) |
0d407d77 | 765 | { |
06f76f0d | 766 | Lisp_Object tail; |
4ed46869 | 767 | |
06f76f0d KH |
768 | for (tail = FONTSET_FACE_ALIST (this); CONSP (tail); |
769 | tail = XCDR (tail)) | |
770 | { | |
771 | FRAME_PTR f = XFRAME (FONTSET_FRAME (this)); | |
772 | int face_id = XINT (XCDR (XCAR (tail))); | |
773 | struct face *face = FACE_FROM_ID (f, face_id); | |
774 | ||
775 | /* Face THIS itself is also freed by the following call. */ | |
776 | free_realized_face (f, face); | |
777 | } | |
778 | } | |
0d407d77 | 779 | } |
06f76f0d | 780 | UNBLOCK_INPUT; |
0d407d77 | 781 | } |
4ed46869 | 782 | |
4ed46869 | 783 | |
0d407d77 KH |
784 | /* Check validity of NAME as a fontset name and return the |
785 | corresponding fontset. If not valid, signal an error. | |
786 | If NAME is t, return Vdefault_fontset. */ | |
787 | ||
788 | static Lisp_Object | |
789 | check_fontset_name (name) | |
790 | Lisp_Object name; | |
791 | { | |
792 | int id; | |
793 | ||
794 | if (EQ (name, Qt)) | |
795 | return Vdefault_fontset; | |
4ed46869 | 796 | |
b7826503 | 797 | CHECK_STRING (name); |
0d407d77 KH |
798 | id = fs_query_fontset (name, 0); |
799 | if (id < 0) | |
9af3dc47 | 800 | error ("Fontset `%s' does not exist", XSTRING (name)->data); |
0d407d77 KH |
801 | return FONTSET_FROM_ID (id); |
802 | } | |
4ed46869 | 803 | |
0d407d77 | 804 | DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0, |
06f76f0d KH |
805 | doc: /* Modify fontset NAME to use FONT-SPEC for characters of CHARSETS. |
806 | ||
807 | CHARSET may be a cons; (FROM . TO), where FROM and TO are characters. | |
808 | In that case, use FONT-SPEC for all characters in the range FROM and | |
809 | TO (inclusive). | |
810 | ||
811 | FONT-SPEC is be a vector; [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ] | |
812 | ||
813 | FONT-SPEC may be a cons; (FAMILY . REGISTRY), where FAMILY is a family | |
814 | name of a font, REGSITRY is a registry name of a font. | |
815 | ||
816 | FONT-SPEC may be a font name string. */) | |
817 | (name, charset, font_spec, frame) | |
818 | Lisp_Object name, charset, font_spec, frame; | |
0d407d77 | 819 | { |
06f76f0d | 820 | Lisp_Object fontset; |
8a9be3ac | 821 | Lisp_Object family, registry; |
06f76f0d | 822 | int charset_id; |
0d407d77 KH |
823 | |
824 | fontset = check_fontset_name (name); | |
825 | ||
06f76f0d | 826 | if (VECTORP (font_spec)) |
0890801b | 827 | { |
06f76f0d KH |
828 | int i; |
829 | Lisp_Object val; | |
830 | ||
831 | font_spec = Fcopy_sequence (font_spec); | |
832 | for (i = 0; i < 5; i++) | |
833 | { | |
834 | val = Faref (font_spec, make_number (i)); | |
835 | if (! NILP (val)) | |
836 | { | |
837 | CHECK_STRING (val); | |
838 | ASET (font_spec, i, Fdowncase (val)); | |
839 | } | |
840 | } | |
841 | val = Faref (font_spec, make_number (5)); | |
842 | CHECK_STRING (val); | |
843 | ASET (font_spec, 5, Fdowncase (val)); | |
0d407d77 | 844 | } |
06f76f0d KH |
845 | else if (STRINGP (font_spec)) |
846 | font_spec = Fdowncase (font_spec); | |
847 | else if (CONSP (font_spec)) | |
0d407d77 | 848 | { |
06f76f0d KH |
849 | CHECK_CONS (font_spec); |
850 | family = XCAR (font_spec); | |
851 | registry = XCDR (font_spec); | |
852 | font_spec = Fmake_vector (make_number (6), Qnil); | |
853 | if (!NILP (family)) | |
854 | { | |
855 | CHECK_STRING (family); | |
856 | ASET (font_spec, 0, Fdowncase (family)); | |
857 | } | |
858 | CHECK_STRING (registry); | |
859 | ASET (font_spec, 5, Fdowncase (registry)); | |
0d407d77 | 860 | } |
4ed46869 | 861 | |
06f76f0d | 862 | if (SYMBOLP (charset)) |
0d407d77 | 863 | { |
06f76f0d | 864 | CHECK_CHARSET (charset); |
4ed46869 | 865 | } |
0d407d77 | 866 | else |
8a9be3ac | 867 | { |
06f76f0d KH |
868 | Lisp_Object from, to; |
869 | ||
870 | /* CHARSET should be (FROM . TO). */ | |
871 | from = Fcar (charset); | |
872 | to = Fcdr (charset); | |
873 | CHECK_CHARACTER (from); | |
874 | CHECK_CHARACTER (to); | |
8a9be3ac | 875 | } |
0d407d77 KH |
876 | |
877 | /* The arg FRAME is kept for backward compatibility. We only check | |
878 | the validity. */ | |
879 | if (!NILP (frame)) | |
b7826503 | 880 | CHECK_LIVE_FRAME (frame); |
4ed46869 | 881 | |
06f76f0d | 882 | FONTSET_SET (fontset, charset, font_spec); |
4ed46869 | 883 | |
06f76f0d KH |
884 | /* Free all realized fontsets whose base is FONTSET. This way, the |
885 | specified character(s) are surely redisplayed by a correct | |
886 | font. */ | |
887 | free_realized_fontsets (fontset); | |
4ed46869 KH |
888 | |
889 | return Qnil; | |
890 | } | |
891 | ||
06f76f0d KH |
892 | |
893 | DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0, | |
894 | doc: /* Create a new fontset NAME from font information in FONTLIST. | |
895 | ||
896 | FONTLIST is an alist of charsets vs corresponding font specifications. | |
897 | Each element of FONTLIST has the form (CHARSET . FONT-SPEC), where | |
898 | a character of CHARSET is displayed by a font that matches FONT-SPEC. | |
899 | ||
900 | FONT-SPEC is a vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ], where | |
901 | FAMILY is a string specifying the font family, | |
902 | WEIGHT is a string specifying the weight of the font, | |
903 | SLANT is a string specifying the slant of the font, | |
904 | WIDTH is a string specifying the width of the font, | |
905 | ADSTYLE is a string specifying the adstyle of the font, | |
906 | REGISTRY is a string specifying the charset-registry of the font. | |
907 | ||
908 | See also the documentation of `set-face-attribute' for the detail of | |
909 | these vector elements. | |
910 | ||
911 | FONT-SPEC may be a font name (string). */) | |
912 | (name, fontlist) | |
913 | Lisp_Object name, fontlist; | |
914 | { | |
915 | Lisp_Object fontset, ascii_font; | |
916 | Lisp_Object tem, tail; | |
917 | ||
918 | CHECK_STRING (name); | |
919 | CHECK_LIST (fontlist); | |
920 | ||
921 | name = Fdowncase (name); | |
922 | tem = Fquery_fontset (name, Qnil); | |
923 | if (! NILP (tem)) | |
924 | free_realized_fontsets (tem); | |
925 | ||
926 | fontset = make_fontset (Qnil, name, Qnil); | |
927 | ||
928 | /* Check the validity of FONTLIST. */ | |
929 | ascii_font = Fcdr (Fassq (Qascii, fontlist)); | |
930 | if (NILP (ascii_font)) | |
931 | error ("No ascii font specified"); | |
932 | if (! STRINGP (ascii_font)) | |
933 | ascii_font = generate_ascii_font (name, ascii_font); | |
934 | ||
935 | fontlist = Fcopy_sequence (fontlist); | |
936 | for (tail = fontlist; ! NILP (tail); tail = Fcdr (tail)) | |
937 | Fset_fontset_font (name, Fcar (Fcar (tail)), Fcdr (Fcar (tail)), Qnil); | |
938 | ||
939 | FONTSET_ASCII (fontset) = ascii_font; | |
940 | ||
941 | return name; | |
942 | } | |
943 | ||
944 | ||
4ed46869 | 945 | DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0, |
335c5470 PJ |
946 | doc: /* Return information about a font named NAME on frame FRAME. |
947 | If FRAME is omitted or nil, use the selected frame. | |
948 | The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE, | |
949 | HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT, | |
950 | where | |
951 | OPENED-NAME is the name used for opening the font, | |
952 | FULL-NAME is the full name of the font, | |
953 | SIZE is the maximum bound width of the font, | |
954 | HEIGHT is the height of the font, | |
955 | BASELINE-OFFSET is the upward offset pixels from ASCII baseline, | |
956 | RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling | |
957 | how to compose characters. | |
958 | If the named font is not yet loaded, return nil. */) | |
959 | (name, frame) | |
4ed46869 KH |
960 | Lisp_Object name, frame; |
961 | { | |
962 | FRAME_PTR f; | |
963 | struct font_info *fontp; | |
964 | Lisp_Object info; | |
965 | ||
966 | (*check_window_system_func) (); | |
967 | ||
b7826503 | 968 | CHECK_STRING (name); |
0d407d77 | 969 | name = Fdowncase (name); |
4ed46869 | 970 | if (NILP (frame)) |
18f39d0e | 971 | frame = selected_frame; |
b7826503 | 972 | CHECK_LIVE_FRAME (frame); |
18f39d0e | 973 | f = XFRAME (frame); |
4ed46869 KH |
974 | |
975 | if (!query_font_func) | |
976 | error ("Font query function is not supported"); | |
977 | ||
978 | fontp = (*query_font_func) (f, XSTRING (name)->data); | |
979 | if (!fontp) | |
980 | return Qnil; | |
981 | ||
0d407d77 | 982 | info = Fmake_vector (make_number (7), Qnil); |
4ed46869 KH |
983 | |
984 | XVECTOR (info)->contents[0] = build_string (fontp->name); | |
985 | XVECTOR (info)->contents[1] = build_string (fontp->full_name); | |
0d407d77 KH |
986 | XVECTOR (info)->contents[2] = make_number (fontp->size); |
987 | XVECTOR (info)->contents[3] = make_number (fontp->height); | |
988 | XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset); | |
989 | XVECTOR (info)->contents[5] = make_number (fontp->relative_compose); | |
990 | XVECTOR (info)->contents[6] = make_number (fontp->default_ascent); | |
4ed46869 KH |
991 | |
992 | return info; | |
993 | } | |
994 | ||
1ff005e1 KH |
995 | |
996 | /* Return the font name for the character at POSITION in the current | |
997 | buffer. This is computed from all the text properties and overlays | |
998 | that apply to POSITION. It returns nil in the following cases: | |
999 | ||
1000 | (1) The window system doesn't have a font for the character (thus | |
1001 | it is displayed by an empty box). | |
1002 | ||
1003 | (2) The character code is invalid. | |
1004 | ||
1005 | (3) The current buffer is not displayed in any window. | |
1006 | ||
1007 | In addition, the returned font name may not take into account of | |
1008 | such redisplay engine hooks as what used in jit-lock-mode if | |
1009 | POSITION is currently not visible. */ | |
1010 | ||
1011 | ||
1012 | DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 1, 0, | |
335c5470 PJ |
1013 | doc: /* For internal use only. */) |
1014 | (position) | |
1ff005e1 KH |
1015 | Lisp_Object position; |
1016 | { | |
1017 | int pos, pos_byte, dummy; | |
1018 | int face_id; | |
1019 | int c; | |
1020 | Lisp_Object window; | |
1021 | struct window *w; | |
1022 | struct frame *f; | |
1023 | struct face *face; | |
1024 | ||
b7826503 | 1025 | CHECK_NUMBER_COERCE_MARKER (position); |
1ff005e1 KH |
1026 | pos = XINT (position); |
1027 | if (pos < BEGV || pos >= ZV) | |
1028 | args_out_of_range_3 (position, make_number (BEGV), make_number (ZV)); | |
1029 | pos_byte = CHAR_TO_BYTE (pos); | |
1030 | c = FETCH_CHAR (pos_byte); | |
851ab85e | 1031 | window = Fget_buffer_window (Fcurrent_buffer (), Qnil); |
1ff005e1 KH |
1032 | if (NILP (window)) |
1033 | return Qnil; | |
1034 | w = XWINDOW (window); | |
1035 | f = XFRAME (w->frame); | |
1036 | face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0); | |
1037 | face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c); | |
1038 | face = FACE_FROM_ID (f, face_id); | |
1039 | return (face->font && face->font_name | |
1040 | ? build_string (face->font_name) | |
1041 | : Qnil); | |
1042 | } | |
1043 | ||
1044 | ||
1045 | /* Called from Ffontset_info via map_char_table on each leaf of | |
1046 | fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last | |
1047 | ARG)' and FONT-INFOs have this form: | |
1048 | (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC) | |
1049 | The current leaf is indexed by CHARACTER and has value ELT. This | |
1050 | function add the information of the current leaf to ARG by | |
1051 | appending a new element or modifying the last element.. */ | |
1052 | ||
1053 | static void | |
1054 | accumulate_font_info (arg, character, elt) | |
1055 | Lisp_Object arg, character, elt; | |
1056 | { | |
1337ac77 | 1057 | Lisp_Object last, last_char, last_elt; |
1ff005e1 | 1058 | |
11d9bd93 | 1059 | if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character))) |
06f76f0d | 1060 | FONTSET_REF (Vdefault_fontset, XINT (character), elt); |
1ff005e1 KH |
1061 | if (!CONSP (elt)) |
1062 | return; | |
1063 | last = XCAR (arg); | |
1064 | last_char = XCAR (XCAR (last)); | |
1065 | last_elt = XCAR (XCDR (XCAR (last))); | |
1066 | elt = XCDR (elt); | |
1067 | if (!NILP (Fequal (elt, last_elt))) | |
1068 | { | |
06f76f0d | 1069 | struct charset *this_charset = CHAR_CHARSET (XINT (character)); |
1ff005e1 KH |
1070 | |
1071 | if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */ | |
1072 | { | |
1073 | if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char)))) | |
1074 | { | |
f3fbd155 | 1075 | XSETCDR (last_char, character); |
1ff005e1 KH |
1076 | return; |
1077 | } | |
1078 | } | |
11d9bd93 KH |
1079 | else if (XINT (last_char) == XINT (character)) |
1080 | return; | |
1081 | else if (this_charset == CHAR_CHARSET (XINT (last_char))) | |
1ff005e1 | 1082 | { |
f3fbd155 | 1083 | XSETCAR (XCAR (last), Fcons (last_char, character)); |
11d9bd93 | 1084 | return; |
1ff005e1 KH |
1085 | } |
1086 | } | |
f3fbd155 KR |
1087 | XSETCDR (last, Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil)); |
1088 | XSETCAR (arg, XCDR (last)); | |
1ff005e1 KH |
1089 | } |
1090 | ||
1091 | ||
4ed46869 | 1092 | DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0, |
335c5470 PJ |
1093 | doc: /* Return information about a fontset named NAME on frame FRAME. |
1094 | The value is a vector: | |
1095 | [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ], | |
1096 | where, | |
1097 | SIZE is the maximum bound width of ASCII font in the fontset, | |
1098 | HEIGHT is the maximum bound height of ASCII font in the fontset, | |
06f76f0d KH |
1099 | CHARSET-OR-RANGE is a charset or a cons of two characters specifying |
1100 | the range of characters. | |
1101 | FONT-SPEC is a fontname pattern string or a vector | |
1102 | [ FAMILY WEIGHT SLANT ADSTYLE REGISTRY ]. | |
1103 | See the documentation of `new-fontset' for the meanings those elements. | |
335c5470 PJ |
1104 | OPENEDs are names of fonts actually opened. |
1105 | If the ASCII font is not yet opened, SIZE and HEIGHT are 0. | |
1106 | If FRAME is omitted, it defaults to the currently selected frame. */) | |
1107 | (name, frame) | |
4ed46869 KH |
1108 | Lisp_Object name, frame; |
1109 | { | |
1ff005e1 | 1110 | Lisp_Object fontset; |
4ed46869 | 1111 | FRAME_PTR f; |
1ff005e1 KH |
1112 | Lisp_Object val, tail, elt; |
1113 | Lisp_Object *realized; | |
a921395d | 1114 | struct font_info *fontp = NULL; |
1ff005e1 | 1115 | int n_realized = 0; |
4ed46869 | 1116 | int i; |
fc8865fc | 1117 | |
4ed46869 KH |
1118 | (*check_window_system_func) (); |
1119 | ||
0d407d77 KH |
1120 | fontset = check_fontset_name (name); |
1121 | ||
4ed46869 | 1122 | if (NILP (frame)) |
18f39d0e | 1123 | frame = selected_frame; |
b7826503 | 1124 | CHECK_LIVE_FRAME (frame); |
18f39d0e | 1125 | f = XFRAME (frame); |
4ed46869 | 1126 | |
11d9bd93 | 1127 | /* Recode realized fontsets whose base is FONTSET in the table |
1ff005e1 KH |
1128 | `realized'. */ |
1129 | realized = (Lisp_Object *) alloca (sizeof (Lisp_Object) | |
1130 | * ASIZE (Vfontset_table)); | |
0d407d77 KH |
1131 | for (i = 0; i < ASIZE (Vfontset_table); i++) |
1132 | { | |
1ff005e1 KH |
1133 | elt = FONTSET_FROM_ID (i); |
1134 | if (!NILP (elt) | |
1135 | && EQ (FONTSET_BASE (elt), fontset)) | |
1136 | realized[n_realized++] = elt; | |
0d407d77 | 1137 | } |
4ed46869 | 1138 | |
1ff005e1 KH |
1139 | /* Accumulate information of the fontset in VAL. The format is |
1140 | (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE | |
1141 | FONT-SPEC). See the comment for accumulate_font_info for the | |
1142 | detail. */ | |
06f76f0d | 1143 | val = Fcons (Fcons (Qascii, Fcons (FONTSET_ASCII (fontset), Qnil)), Qnil); |
1ff005e1 | 1144 | val = Fcons (val, val); |
06f76f0d KH |
1145 | for (i = 128; i <= MAX_CHAR; ) |
1146 | { | |
1147 | Lisp_Object elt; | |
1148 | int from, to; | |
1149 | ||
1150 | elt = char_table_ref_and_range (fontset, i, &from, &to); | |
1151 | if (! NILP (elt)) | |
1152 | { | |
1153 | elt = Fcons (Fcons (make_number (from), make_number (to)), | |
1154 | Fcons (elt, Qnil)); | |
1155 | XSETCDR (XCAR (val), Fcons (elt, Qnil)); | |
1156 | XSETCAR (val, XCDR (XCAR (val))); | |
1157 | } | |
1158 | i = to + 1; | |
1159 | } | |
1160 | ||
1161 | for (tail = FONTSET_CHARSET_ALIST (fontset); | |
1162 | CONSP (tail); tail = XCDR (tail)) | |
1163 | { | |
1164 | elt = XCAR (tail); | |
1165 | elt = Fcons (XCAR (elt), Fcons (XCDR (elt), Qnil)); | |
1166 | XSETCDR (XCAR (val), Fcons (elt, Qnil)); | |
1167 | XSETCAR (val, XCDR (XCAR (val))); | |
1168 | } | |
1169 | ||
1ff005e1 KH |
1170 | val = XCDR (val); |
1171 | ||
06f76f0d | 1172 | /* If fonts are opened for FONT-SPEC, append the names of the fonts to |
1ff005e1 KH |
1173 | FONT-SPEC. */ |
1174 | for (tail = val; CONSP (tail); tail = XCDR (tail)) | |
0d407d77 | 1175 | { |
1ff005e1 | 1176 | int c; |
06f76f0d | 1177 | |
1ff005e1 | 1178 | elt = XCAR (tail); |
1ff005e1 KH |
1179 | for (i = 0; i < n_realized; i++) |
1180 | { | |
06f76f0d | 1181 | int face_id; |
0d407d77 | 1182 | struct face *face; |
06f76f0d | 1183 | Lisp_Object face_list, fontname; |
0d407d77 | 1184 | |
06f76f0d KH |
1185 | for (face_list = FONTSET_FACE_ALIST (realized[i]); |
1186 | CONSP (face_list); face_list = XCDR (face_list)) | |
0d407d77 | 1187 | { |
06f76f0d KH |
1188 | int face_id = XINT (XCDR (XCAR (face_list))); |
1189 | struct face *face = FACE_FROM_ID (f, face_id); | |
1190 | ||
1191 | if (face->font && face->font_name) | |
1ff005e1 | 1192 | { |
06f76f0d KH |
1193 | fontname = build_string (face->font_name); |
1194 | if (NILP (Fmember (fontname, XCDR (XCDR (elt))))) | |
1195 | XSETCDR (XCDR (elt), Fcons (fontname, XCDR (XCDR (elt)))); | |
1ff005e1 | 1196 | } |
0d407d77 | 1197 | } |
0d407d77 KH |
1198 | } |
1199 | } | |
a921395d | 1200 | |
06f76f0d | 1201 | elt = XCDR (XCDR (XCAR (val))); |
a921395d | 1202 | if (CONSP (elt)) |
06f76f0d | 1203 | fontp = (*query_font_func) (f, XSTRING (XCAR (elt))->data); |
a921395d KH |
1204 | val = Fmake_vector (make_number (3), val); |
1205 | AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0); | |
1206 | AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0); | |
1207 | return val; | |
4ed46869 KH |
1208 | } |
1209 | ||
0d407d77 | 1210 | DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0, |
335c5470 PJ |
1211 | doc: /* Return a font name pattern for character CH in fontset NAME. |
1212 | If NAME is t, find a font name pattern in the default fontset. */) | |
1213 | (name, ch) | |
0d407d77 KH |
1214 | Lisp_Object name, ch; |
1215 | { | |
1337ac77 | 1216 | int c; |
0d407d77 KH |
1217 | Lisp_Object fontset, elt; |
1218 | ||
1219 | fontset = check_fontset_name (name); | |
1220 | ||
06f76f0d | 1221 | CHECK_CHARACTER (ch); |
0d407d77 | 1222 | c = XINT (ch); |
06f76f0d | 1223 | FONTSET_REF (fontset, c, elt); |
0d407d77 KH |
1224 | return elt; |
1225 | } | |
0d407d77 KH |
1226 | |
1227 | DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0, | |
335c5470 PJ |
1228 | doc: /* Return a list of all defined fontset names. */) |
1229 | () | |
0d407d77 KH |
1230 | { |
1231 | Lisp_Object fontset, list; | |
1232 | int i; | |
1233 | ||
1234 | list = Qnil; | |
1235 | for (i = 0; i < ASIZE (Vfontset_table); i++) | |
1236 | { | |
1237 | fontset = FONTSET_FROM_ID (i); | |
1238 | if (!NILP (fontset) | |
1239 | && BASE_FONTSET_P (fontset)) | |
1240 | list = Fcons (FONTSET_NAME (fontset), list); | |
1241 | } | |
1ff005e1 | 1242 | |
0d407d77 KH |
1243 | return list; |
1244 | } | |
1245 | ||
dfcf069d | 1246 | void |
4ed46869 KH |
1247 | syms_of_fontset () |
1248 | { | |
4ed46869 KH |
1249 | if (!load_font_func) |
1250 | /* Window system initializer should have set proper functions. */ | |
1251 | abort (); | |
1252 | ||
6a7e6d80 | 1253 | Qfontset = intern ("fontset"); |
4ed46869 | 1254 | staticpro (&Qfontset); |
06f76f0d | 1255 | Fput (Qfontset, Qchar_table_extra_slots, make_number (7)); |
4ed46869 KH |
1256 | |
1257 | Vcached_fontset_data = Qnil; | |
1258 | staticpro (&Vcached_fontset_data); | |
1259 | ||
0d407d77 KH |
1260 | Vfontset_table = Fmake_vector (make_number (32), Qnil); |
1261 | staticpro (&Vfontset_table); | |
0d407d77 KH |
1262 | |
1263 | Vdefault_fontset = Fmake_char_table (Qfontset, Qnil); | |
1264 | staticpro (&Vdefault_fontset); | |
1ff005e1 KH |
1265 | FONTSET_ID (Vdefault_fontset) = make_number (0); |
1266 | FONTSET_NAME (Vdefault_fontset) | |
1267 | = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"); | |
06f76f0d KH |
1268 | { |
1269 | Lisp_Object default_ascii_font; | |
1270 | ||
82d9a3b9 | 1271 | #if defined (macintosh) |
06f76f0d KH |
1272 | default_ascii_font |
1273 | = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"); | |
82d9a3b9 | 1274 | #elif defined (WINDOWSNT) |
06f76f0d KH |
1275 | default_ascii_font |
1276 | = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"); | |
1a578e9b | 1277 | #else |
06f76f0d KH |
1278 | default_ascii_font |
1279 | = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"); | |
1a578e9b | 1280 | #endif |
06f76f0d KH |
1281 | FONTSET_ASCII (Vdefault_fontset) = default_ascii_font; |
1282 | } | |
1ff005e1 KH |
1283 | AREF (Vfontset_table, 0) = Vdefault_fontset; |
1284 | next_fontset_id = 1; | |
4ed46869 KH |
1285 | |
1286 | DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist, | |
335c5470 PJ |
1287 | doc: /* Alist of fontname patterns vs corresponding encoding info. |
1288 | Each element looks like (REGEXP . ENCODING-INFO), | |
1289 | where ENCODING-INFO is an alist of CHARSET vs ENCODING. | |
1290 | ENCODING is one of the following integer values: | |
1291 | 0: code points 0x20..0x7F or 0x2020..0x7F7F are used, | |
1292 | 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used, | |
1293 | 2: code points 0x20A0..0x7FFF are used, | |
1294 | 3: code points 0xA020..0xFF7F are used. */); | |
4ed46869 KH |
1295 | Vfont_encoding_alist = Qnil; |
1296 | ||
6a7e6d80 | 1297 | DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent, |
335c5470 PJ |
1298 | doc: /* Char table of characters whose ascent values should be ignored. |
1299 | If an entry for a character is non-nil, the ascent value of the glyph | |
1300 | is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font. | |
1301 | ||
1302 | This affects how a composite character which contains | |
1303 | such a character is displayed on screen. */); | |
2aeafb78 KH |
1304 | Vuse_default_ascent = Qnil; |
1305 | ||
1306 | DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition, | |
335c5470 PJ |
1307 | doc: /* Char table of characters which is not composed relatively. |
1308 | If an entry for a character is non-nil, a composition sequence | |
1309 | which contains that character is displayed so that | |
1310 | the glyph of that character is put without considering | |
1311 | an ascent and descent value of a previous character. */); | |
810abb87 | 1312 | Vignore_relative_composition = Qnil; |
6a7e6d80 | 1313 | |
01d4b817 | 1314 | DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist, |
335c5470 PJ |
1315 | doc: /* Alist of fontname vs list of the alternate fontnames. |
1316 | When a specified font name is not found, the corresponding | |
1317 | alternate fontnames (if any) are tried instead. */); | |
01d4b817 | 1318 | Valternate_fontname_alist = Qnil; |
8c83e4f9 | 1319 | |
1c283e35 | 1320 | DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist, |
335c5470 | 1321 | doc: /* Alist of fontset names vs the aliases. */); |
1ff005e1 KH |
1322 | Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset), |
1323 | build_string ("fontset-default")), | |
1324 | Qnil); | |
1c283e35 | 1325 | |
810abb87 KH |
1326 | DEFVAR_LISP ("vertical-centering-font-regexp", |
1327 | &Vvertical_centering_font_regexp, | |
335c5470 PJ |
1328 | doc: /* *Regexp matching font names that require vertical centering on display. |
1329 | When a character is displayed with such fonts, the character is displayed | |
fc8865fc | 1330 | at the vertical center of lines. */); |
810abb87 KH |
1331 | Vvertical_centering_font_regexp = Qnil; |
1332 | ||
4ed46869 KH |
1333 | defsubr (&Squery_fontset); |
1334 | defsubr (&Snew_fontset); | |
1335 | defsubr (&Sset_fontset_font); | |
1336 | defsubr (&Sfont_info); | |
1ff005e1 | 1337 | defsubr (&Sinternal_char_font); |
4ed46869 | 1338 | defsubr (&Sfontset_info); |
0d407d77 KH |
1339 | defsubr (&Sfontset_font); |
1340 | defsubr (&Sfontset_list); | |
4ed46869 | 1341 | } |