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