1/* Fontset handler. 2 Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 3 Free Software Foundation, Inc. 4 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 5 2005, 2006, 2007 6 National Institute of Advanced Industrial Science and Technology (AIST) 7 Registration Number H14PRO021 8 9This file is part of GNU Emacs. 10 11GNU Emacs is free software; you can redistribute it and/or modify 12it under the terms of the GNU General Public License as published by 13the Free Software Foundation; either version 2, or (at your option) 14any later version. 15 16GNU Emacs is distributed in the hope that it will be useful, 17but WITHOUT ANY WARRANTY; without even the implied warranty of 18MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19GNU General Public License for more details. 20 21You should have received a copy of the GNU General Public License 22along with GNU Emacs; see the file COPYING. If not, write to 23the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24Boston, MA 02110-1301, USA. */ 25 26/* #define FONTSET_DEBUG */ 27 28#include <config.h> 29 30#ifdef FONTSET_DEBUG 31#include <stdio.h> 32#endif 33 34#include "lisp.h" 35#include "buffer.h" 36#include "charset.h" 37#include "ccl.h" 38#include "keyboard.h" 39#include "frame.h" 40#include "dispextern.h" 41#include "fontset.h" 42#include "window.h" 43#ifdef HAVE_X_WINDOWS 44#include "xterm.h" 45#endif 46#ifdef WINDOWSNT 47#include "w32term.h" 48#endif 49#ifdef MAC_OS 50#include "macterm.h" 51#endif 52 53#ifdef FONTSET_DEBUG 54#undef xassert 55#define xassert(X) do {if (!(X)) abort ();} while (0) 56#undef INLINE 57#define INLINE 58#endif 59 60 61/* FONTSET 62 63 A fontset is a collection of font related information to give 64 similar appearance (style, size, etc) of characters. There are two 65 kinds of fontsets; base and realized. A base fontset is created by 66 new-fontset from Emacs Lisp explicitly. A realized fontset is 67 created implicitly when a face is realized for ASCII characters. A 68 face is also realized for multibyte characters based on an ASCII 69 face. All of the multibyte faces based on the same ASCII face 70 share the same realized fontset. 71 72 A fontset object is implemented by a char-table. 73 74 An element of a base fontset is: 75 (INDEX . FONTNAME) or 76 (INDEX . (FOUNDRY . REGISTRY )) 77 FONTNAME is a font name pattern for the corresponding character. 78 FOUNDRY and REGISTRY are respectively foundry and registry fields of 79 a font name for the corresponding character. INDEX specifies for 80 which character (or generic character) the element is defined. It 81 may be different from an index to access this element. For 82 instance, if a fontset defines some font for all characters of 83 charset `japanese-jisx0208', INDEX is the generic character of this 84 charset. REGISTRY is the 85 86 An element of a realized fontset is FACE-ID which is a face to use 87 for displaying the corresponding character. 88 89 All single byte characters (ASCII and 8bit-unibyte) share the same 90 element in a fontset. The element is stored in the first element 91 of the fontset. 92 93 To access or set each element, use macros FONTSET_REF and 94 FONTSET_SET respectively for efficiency. 95 96 A fontset has 3 extra slots. 97 98 The 1st slot is an ID number of the fontset. 99 100 The 2nd slot is a name of the fontset. This is nil for a realized 101 face. 102 103 The 3rd slot is a frame that the fontset belongs to. This is nil 104 for a default face. 105 106 A parent of a base fontset is nil. A parent of a realized fontset 107 is a base fontset. 108 109 All fontsets are recorded in Vfontset_table. 110 111 112 DEFAULT FONTSET 113 114 There's a special fontset named `default fontset' which defines a 115 default fontname pattern. When a base fontset doesn't specify a 116 font for a specific character, the corresponding value in the 117 default fontset is used. The format is the same as a base fontset. 118 119 The parent of a realized fontset created for such a face that has 120 no fontset is the default fontset. 121 122 123 These structures are hidden from the other codes than this file. 124 The other codes handle fontsets only by their ID numbers. They 125 usually use variable name `fontset' for IDs. But, in this file, we 126 always use variable name `id' for IDs, and name `fontset' for the 127 actual fontset objects. 128 129*/ 130 131/********** VARIABLES and FUNCTION PROTOTYPES **********/ 132 133extern Lisp_Object Qfont; 134Lisp_Object Qfontset; 135 136/* Vector containing all fontsets. */ 137static Lisp_Object Vfontset_table; 138 139/* Next possibly free fontset ID. Usually this keeps the minimum 140 fontset ID not yet used. */ 141static int next_fontset_id; 142 143/* The default fontset. This gives default FAMILY and REGISTRY of 144 font for each characters. */ 145static Lisp_Object Vdefault_fontset; 146 147/* Alist of font specifications. It override the font specification 148 in the default fontset. */ 149static Lisp_Object Voverriding_fontspec_alist; 150 151Lisp_Object Vfont_encoding_alist; 152Lisp_Object Vuse_default_ascent; 153Lisp_Object Vignore_relative_composition; 154Lisp_Object Valternate_fontname_alist; 155Lisp_Object Vfontset_alias_alist; 156Lisp_Object Vvertical_centering_font_regexp; 157 158/* The following six are declarations of callback functions depending 159 on window system. See the comments in src/fontset.h for more 160 detail. */ 161 162/* Return a pointer to struct font_info of font FONT_IDX of frame F. */ 163struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx)); 164 165/* Return a list of font names which matches PATTERN. See the documentation 166 of `x-list-fonts' for more details. */ 167Lisp_Object (*list_fonts_func) P_ ((struct frame *f, 168 Lisp_Object pattern, 169 int size, 170 int maxnames)); 171 172/* Load a font named NAME for frame F and return a pointer to the 173 information of the loaded font. If loading is failed, return 0. */ 174struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int)); 175 176/* Return a pointer to struct font_info of a font named NAME for frame F. */ 177struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name)); 178 179/* Additional function for setting fontset or changing fontset 180 contents of frame F. */ 181void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg, 182 Lisp_Object oldval)); 183 184/* To find a CCL program, fs_load_font calls this function. 185 The argument is a pointer to the struct font_info. 186 This function set the member `encoder' of the structure. */ 187void (*find_ccl_program_func) P_ ((struct font_info *)); 188 189/* Check if any window system is used now. */ 190void (*check_window_system_func) P_ ((void)); 191 192 193/* Prototype declarations for static functions. */ 194static Lisp_Object fontset_ref P_ ((Lisp_Object, int)); 195static Lisp_Object lookup_overriding_fontspec P_ ((Lisp_Object, int)); 196static void fontset_set P_ ((Lisp_Object, int, Lisp_Object)); 197static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); 198static int fontset_id_valid_p P_ ((int)); 199static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object)); 200static Lisp_Object font_family_registry P_ ((Lisp_Object, int)); 201static Lisp_Object regularize_fontname P_ ((Lisp_Object)); 202 203 204/********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/ 205 206/* Return the fontset with ID. No check of ID's validness. */ 207#define FONTSET_FROM_ID(id) AREF (Vfontset_table, id) 208 209/* Macros to access special values of FONTSET. */ 210#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0] 211#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1] 212#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2] 213#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0] 214#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent 215 216#define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset)) 217 218 219/* Return the element of FONTSET (char-table) at index C (character). */ 220 221#define FONTSET_REF(fontset, c) fontset_ref (fontset, c) 222 223static Lisp_Object 224fontset_ref (fontset, c) 225 Lisp_Object fontset; 226 int c; 227{ 228 int charset, c1, c2; 229 Lisp_Object elt, defalt; 230 231 if (SINGLE_BYTE_CHAR_P (c)) 232 return FONTSET_ASCII (fontset); 233 234 SPLIT_CHAR (c, charset, c1, c2); 235 elt = XCHAR_TABLE (fontset)->contents[charset + 128]; 236 if (!SUB_CHAR_TABLE_P (elt)) 237 return elt; 238 defalt = XCHAR_TABLE (elt)->defalt; 239 if (c1 < 32 240 || (elt = XCHAR_TABLE (elt)->contents[c1], 241 NILP (elt))) 242 return defalt; 243 if (!SUB_CHAR_TABLE_P (elt)) 244 return elt; 245 defalt = XCHAR_TABLE (elt)->defalt; 246 if (c2 < 32 247 || (elt = XCHAR_TABLE (elt)->contents[c2], 248 NILP (elt))) 249 return defalt; 250 return elt; 251} 252 253 254static Lisp_Object 255lookup_overriding_fontspec (frame, c) 256 Lisp_Object frame; 257 int c; 258{ 259 Lisp_Object tail; 260 261 for (tail = Voverriding_fontspec_alist; CONSP (tail); tail = XCDR (tail)) 262 { 263 Lisp_Object val, target, elt; 264 265 val = XCAR (tail); 266 target = XCAR (val); 267 val = XCDR (val); 268 /* Now VAL is (NO-FRAME-LIST OK-FRAME-LIST CHAR FONTNAME). */ 269 if (NILP (Fmemq (frame, XCAR (val))) 270 && (CHAR_TABLE_P (target) 271 ? ! NILP (CHAR_TABLE_REF (target, c)) 272 : XINT (target) == CHAR_CHARSET (c))) 273 { 274 val = XCDR (val); 275 elt = XCDR (val); 276 if (NILP (Fmemq (frame, XCAR (val)))) 277 { 278 if (! face_font_available_p (XFRAME (frame), XCDR (elt))) 279 { 280 val = XCDR (XCAR (tail)); 281 XSETCAR (val, Fcons (frame, XCAR (val))); 282 continue; 283 } 284 XSETCAR (val, Fcons (frame, XCAR (val))); 285 } 286 if (NILP (XCAR (elt))) 287 XSETCAR (elt, make_number (c)); 288 return elt; 289 } 290 } 291 return Qnil; 292} 293 294#define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c) 295 296static Lisp_Object 297fontset_ref_via_base (fontset, c) 298 Lisp_Object fontset; 299 int *c; 300{ 301 int charset, c1, c2; 302 Lisp_Object elt; 303 304 if (SINGLE_BYTE_CHAR_P (*c)) 305 return FONTSET_ASCII (fontset); 306 307 elt = Qnil; 308 if (! EQ (FONTSET_BASE (fontset), Vdefault_fontset)) 309 elt = FONTSET_REF (FONTSET_BASE (fontset), *c); 310 if (NILP (elt)) 311 elt = lookup_overriding_fontspec (FONTSET_FRAME (fontset), *c); 312 if (NILP (elt)) 313 elt = FONTSET_REF (Vdefault_fontset, *c); 314 if (NILP (elt)) 315 return Qnil; 316 317 *c = XINT (XCAR (elt)); 318 SPLIT_CHAR (*c, charset, c1, c2); 319 elt = XCHAR_TABLE (fontset)->contents[charset + 128]; 320 if (c1 < 32) 321 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt); 322 if (!SUB_CHAR_TABLE_P (elt)) 323 return Qnil; 324 elt = XCHAR_TABLE (elt)->contents[c1]; 325 if (c2 < 32) 326 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt); 327 if (!SUB_CHAR_TABLE_P (elt)) 328 return Qnil; 329 elt = XCHAR_TABLE (elt)->contents[c2]; 330 return elt; 331} 332 333 334/* Store into the element of FONTSET at index C the value NEWELT. */ 335#define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt) 336 337static void 338fontset_set (fontset, c, newelt) 339 Lisp_Object fontset; 340 int c; 341 Lisp_Object newelt; 342{ 343 int charset, code[3]; 344 Lisp_Object *elt; 345 int i; 346 347 if (SINGLE_BYTE_CHAR_P (c)) 348 { 349 FONTSET_ASCII (fontset) = newelt; 350 return; 351 } 352 353 SPLIT_CHAR (c, charset, code[0], code[1]); 354 code[2] = 0; /* anchor */ 355 elt = &XCHAR_TABLE (fontset)->contents[charset + 128]; 356 for (i = 0; code[i] > 0; i++) 357 { 358 if (!SUB_CHAR_TABLE_P (*elt)) 359 { 360 Lisp_Object val = *elt; 361 *elt = make_sub_char_table (Qnil); 362 XCHAR_TABLE (*elt)->defalt = val; 363 } 364 elt = &XCHAR_TABLE (*elt)->contents[code[i]]; 365 } 366 if (SUB_CHAR_TABLE_P (*elt)) 367 XCHAR_TABLE (*elt)->defalt = newelt; 368 else 369 *elt = newelt; 370} 371 372 373/* Return a newly created fontset with NAME. If BASE is nil, make a 374 base fontset. Otherwise make a realized fontset whose parent is 375 BASE. */ 376 377static Lisp_Object 378make_fontset (frame, name, base) 379 Lisp_Object frame, name, base; 380{ 381 Lisp_Object fontset; 382 int size = ASIZE (Vfontset_table); 383 int id = next_fontset_id; 384 385 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is 386 the next available fontset ID. So it is expected that this loop 387 terminates quickly. In addition, as the last element of 388 Vfontset_table is always nil, we don't have to check the range of 389 id. */ 390 while (!NILP (AREF (Vfontset_table, id))) id++; 391 392 if (id + 1 == size) 393 { 394 Lisp_Object tem; 395 int i; 396 397 tem = Fmake_vector (make_number (size + 8), Qnil); 398 for (i = 0; i < size; i++) 399 AREF (tem, i) = AREF (Vfontset_table, i); 400 Vfontset_table = tem; 401 } 402 403 fontset = Fmake_char_table (Qfontset, Qnil); 404 405 FONTSET_ID (fontset) = make_number (id); 406 FONTSET_NAME (fontset) = name; 407 FONTSET_FRAME (fontset) = frame; 408 FONTSET_BASE (fontset) = base; 409 410 AREF (Vfontset_table, id) = fontset; 411 next_fontset_id = id + 1; 412 return fontset; 413} 414 415 416/* Return 1 if ID is a valid fontset id, else return 0. */ 417 418static INLINE int 419fontset_id_valid_p (id) 420 int id; 421{ 422 return (id >= 0 && id < ASIZE (Vfontset_table) - 1); 423} 424 425 426/* Extract `family' and `registry' string from FONTNAME and a cons of 427 them. Actually, `family' may also contain `foundry', `registry' 428 may also contain `encoding' of FONTNAME. But, if FONTNAME doesn't 429 conform to XLFD nor explicitely specifies the other fields 430 (i.e. not using wildcard `*'), return FONTNAME. If FORCE is 431 nonzero, specifications of the other fields are ignored, and return 432 a cons as far as FONTNAME conform to XLFD. */ 433 434static Lisp_Object 435font_family_registry (fontname, force) 436 Lisp_Object fontname; 437 int force; 438{ 439 Lisp_Object family, registry; 440 const char *p = SDATA (fontname); 441 const char *sep[15]; 442 int i = 0; 443 444 while (*p && i < 15) 445 if (*p++ == '-') 446 { 447 if (!force && i >= 2 && i <= 11 && *p != '*' && p[1] != '-') 448 return fontname; 449 sep[i++] = p; 450 } 451 if (i != 14) 452 return fontname; 453 454 family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]); 455 registry = make_unibyte_string (sep[12], p - sep[12]); 456 return Fcons (family, registry); 457} 458 459 460/********** INTERFACES TO xfaces.c and dispextern.h **********/ 461 462/* Return name of the fontset with ID. */ 463 464Lisp_Object 465fontset_name (id) 466 int id; 467{ 468 Lisp_Object fontset; 469 fontset = FONTSET_FROM_ID (id); 470 return FONTSET_NAME (fontset); 471} 472 473 474/* Return ASCII font name of the fontset with ID. */ 475 476Lisp_Object 477fontset_ascii (id) 478 int id; 479{ 480 Lisp_Object fontset, elt; 481 fontset= FONTSET_FROM_ID (id); 482 elt = FONTSET_ASCII (fontset); 483 return XCDR (elt); 484} 485 486 487/* Free fontset of FACE. Called from free_realized_face. */ 488 489void 490free_face_fontset (f, face) 491 FRAME_PTR f; 492 struct face *face; 493{ 494 if (fontset_id_valid_p (face->fontset)) 495 { 496 AREF (Vfontset_table, face->fontset) = Qnil; 497 if (face->fontset < next_fontset_id) 498 next_fontset_id = face->fontset; 499 } 500} 501 502 503/* Return 1 iff FACE is suitable for displaying character C. 504 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P 505 when C is not a single byte character.. */ 506 507int 508face_suitable_for_char_p (face, c) 509 struct face *face; 510 int c; 511{ 512 Lisp_Object fontset, elt; 513 514 if (SINGLE_BYTE_CHAR_P (c)) 515 return (face == face->ascii_face); 516 517 xassert (fontset_id_valid_p (face->fontset)); 518 fontset = FONTSET_FROM_ID (face->fontset); 519 xassert (!BASE_FONTSET_P (fontset)); 520 521 elt = FONTSET_REF_VIA_BASE (fontset, c); 522 return (!NILP (elt) && face->id == XFASTINT (elt)); 523} 524 525 526/* Return ID of face suitable for displaying character C on frame F. 527 The selection of face is done based on the fontset of FACE. FACE 528 should already have been realized for ASCII characters. Called 529 from the macro FACE_FOR_CHAR when C is not a single byte character. */ 530 531int 532face_for_char (f, face, c) 533 FRAME_PTR f; 534 struct face *face; 535 int c; 536{ 537 Lisp_Object fontset, elt; 538 int face_id; 539 540 xassert (fontset_id_valid_p (face->fontset)); 541 fontset = FONTSET_FROM_ID (face->fontset); 542 xassert (!BASE_FONTSET_P (fontset)); 543 544 elt = FONTSET_REF_VIA_BASE (fontset, c); 545 if (!NILP (elt)) 546 return XINT (elt); 547 548 /* No face is recorded for C in the fontset of FACE. Make a new 549 realized face for C that has the same fontset. */ 550 face_id = lookup_face (f, face->lface, c, face); 551 552 /* Record the face ID in FONTSET at the same index as the 553 information in the base fontset. */ 554 FONTSET_SET (fontset, c, make_number (face_id)); 555 return face_id; 556} 557 558 559/* Make a realized fontset for ASCII face FACE on frame F from the 560 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the 561 default fontset as the base. Value is the id of the new fontset. 562 Called from realize_x_face. */ 563 564int 565make_fontset_for_ascii_face (f, base_fontset_id) 566 FRAME_PTR f; 567 int base_fontset_id; 568{ 569 Lisp_Object base_fontset, fontset, frame; 570 571 XSETFRAME (frame, f); 572 if (base_fontset_id >= 0) 573 { 574 base_fontset = FONTSET_FROM_ID (base_fontset_id); 575 if (!BASE_FONTSET_P (base_fontset)) 576 base_fontset = FONTSET_BASE (base_fontset); 577 xassert (BASE_FONTSET_P (base_fontset)); 578 } 579 else 580 base_fontset = Vdefault_fontset; 581 582 fontset = make_fontset (frame, Qnil, base_fontset); 583 return XINT (FONTSET_ID (fontset)); 584} 585 586 587/* Return the font name pattern for C that is recorded in the fontset 588 with ID. If a font name pattern is specified (instead of a cons of 589 family and registry), check if a font can be opened by that pattern 590 to get the fullname. If a font is opened, return that name. 591 Otherwise, return nil. If ID is -1, or the fontset doesn't contain 592 information about C, get the registry and encoding of C from the 593 default fontset. Called from choose_face_font. */ 594 595Lisp_Object 596fontset_font_pattern (f, id, c) 597 FRAME_PTR f; 598 int id, c; 599{ 600 Lisp_Object fontset, elt; 601 struct font_info *fontp; 602 603 elt = Qnil; 604 if (fontset_id_valid_p (id)) 605 { 606 fontset = FONTSET_FROM_ID (id); 607 xassert (!BASE_FONTSET_P (fontset)); 608 fontset = FONTSET_BASE (fontset); 609 if (! EQ (fontset, Vdefault_fontset)) 610 elt = FONTSET_REF (fontset, c); 611 } 612 if (NILP (elt)) 613 { 614 Lisp_Object frame; 615 616 XSETFRAME (frame, f); 617 elt = lookup_overriding_fontspec (frame, c); 618 } 619 if (NILP (elt)) 620 elt = FONTSET_REF (Vdefault_fontset, c); 621 622 if (!CONSP (elt)) 623 return Qnil; 624 if (CONSP (XCDR (elt))) 625 return XCDR (elt); 626 627 /* The fontset specifies only a font name pattern (not cons of 628 family and registry). If a font can be opened by that pattern, 629 return the name of opened font. Otherwise return nil. The 630 exception is a font for single byte characters. In that case, we 631 return a cons of FAMILY and REGISTRY extracted from the opened 632 font name. */ 633 elt = XCDR (elt); 634 xassert (STRINGP (elt)); 635 fontp = FS_LOAD_FONT (f, c, SDATA (elt), -1); 636 if (!fontp) 637 return Qnil; 638 639 return font_family_registry (build_string (fontp->full_name), 640 SINGLE_BYTE_CHAR_P (c)); 641} 642 643 644#if defined(WINDOWSNT) && defined (_MSC_VER) 645#pragma optimize("", off) 646#endif 647 648/* Load a font named FONTNAME to display character C on frame F. 649 Return a pointer to the struct font_info of the loaded font. If 650 loading fails, return NULL. If FACE is non-zero and a fontset is 651 assigned to it, record FACE->id in the fontset for C. If FONTNAME 652 is NULL, the name is taken from the fontset of FACE or what 653 specified by ID. */ 654 655struct font_info * 656fs_load_font (f, c, fontname, id, face) 657 FRAME_PTR f; 658 int c; 659 char *fontname; 660 int id; 661 struct face *face; 662{ 663 Lisp_Object fontset; 664 Lisp_Object list, elt, fullname; 665 int size = 0; 666 struct font_info *fontp; 667 int charset = CHAR_CHARSET (c); 668 669 if (face) 670 id = face->fontset; 671 if (id < 0) 672 fontset = Qnil; 673 else 674 fontset = FONTSET_FROM_ID (id); 675 676 if (!NILP (fontset) 677 && !BASE_FONTSET_P (fontset)) 678 { 679 elt = FONTSET_REF_VIA_BASE (fontset, c); 680 if (!NILP (elt)) 681 { 682 /* A suitable face for C is already recorded, which means 683 that a proper font is already loaded. */ 684 int face_id = XINT (elt); 685 686 xassert (face_id == face->id); 687 face = FACE_FROM_ID (f, face_id); 688 return (*get_font_info_func) (f, face->font_info_id); 689 } 690 691 if (!fontname && charset == CHARSET_ASCII) 692 { 693 elt = FONTSET_ASCII (fontset); 694 fontname = SDATA (XCDR (elt)); 695 } 696 } 697 698 if (!fontname) 699 /* No way to get fontname. */ 700 return 0; 701 702 fontp = (*load_font_func) (f, fontname, size); 703 if (!fontp) 704 return 0; 705 706 /* Fill in members (charset, vertical_centering, encoding, etc) of 707 font_info structure that are not set by (*load_font_func). */ 708 fontp->charset = charset; 709 710 fullname = build_string (fontp->full_name); 711 fontp->vertical_centering 712 = (STRINGP (Vvertical_centering_font_regexp) 713 && (fast_string_match_ignore_case 714 (Vvertical_centering_font_regexp, fullname) >= 0)); 715 716 if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED) 717 { 718 /* The font itself tells which code points to be used. Use this 719 encoding for all other charsets. */ 720 int i; 721 722 fontp->encoding[0] = fontp->encoding[1]; 723 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++) 724 fontp->encoding[i] = fontp->encoding[1]; 725 } 726 else 727 { 728 /* The font itself doesn't have information about encoding. */ 729 int i; 730 731 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F), 732 others is 1 (i.e. 0x80..0xFF). */ 733 fontp->encoding[0] = 0; 734 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++) 735 fontp->encoding[i] = 1; 736 /* Then override them by a specification in Vfont_encoding_alist. */ 737 for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list)) 738 { 739 elt = XCAR (list); 740 if (CONSP (elt) 741 && STRINGP (XCAR (elt)) && CONSP (XCDR (elt)) 742 && (fast_string_match_ignore_case (XCAR (elt), fullname) >= 0)) 743 { 744 Lisp_Object tmp; 745 746 for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp)) 747 if (CONSP (XCAR (tmp)) 748 && ((i = get_charset_id (XCAR (XCAR (tmp)))) 749 >= 0) 750 && INTEGERP (XCDR (XCAR (tmp))) 751 && XFASTINT (XCDR (XCAR (tmp))) < 4) 752 fontp->encoding[i] 753 = XFASTINT (XCDR (XCAR (tmp))); 754 } 755 } 756 } 757 758 if (! fontp->font_encoder && find_ccl_program_func) 759 (*find_ccl_program_func) (fontp); 760 761 /* If we loaded a font for a face that has fontset, record the face 762 ID in the fontset for C. */ 763 if (face 764 && !NILP (fontset) 765 && !BASE_FONTSET_P (fontset)) 766 FONTSET_SET (fontset, c, make_number (face->id)); 767 return fontp; 768} 769 770#if defined(WINDOWSNT) && defined (_MSC_VER) 771#pragma optimize("", on) 772#endif 773 774/* Set the ASCII font of the default fontset to FONTNAME if that is 775 not yet set. */ 776void 777set_default_ascii_font (fontname) 778 Lisp_Object fontname; 779{ 780 if (! CONSP (FONTSET_ASCII (Vdefault_fontset))) 781 { 782 int id = fs_query_fontset (fontname, 2); 783 784 if (id >= 0) 785 fontname = XCDR (FONTSET_ASCII (FONTSET_FROM_ID (id))); 786 FONTSET_ASCII (Vdefault_fontset) 787 = Fcons (make_number (0), fontname); 788 } 789} 790 791 792/* Cache data used by fontset_pattern_regexp. The car part is a 793 pattern string containing at least one wild card, the cdr part is 794 the corresponding regular expression. */ 795static Lisp_Object Vcached_fontset_data; 796 797#define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data))) 798#define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data)) 799 800/* If fontset name PATTERN contains any wild card, return regular 801 expression corresponding to PATTERN. */ 802 803static Lisp_Object 804fontset_pattern_regexp (pattern) 805 Lisp_Object pattern; 806{ 807 if (!index (SDATA (pattern), '*') 808 && !index (SDATA (pattern), '?')) 809 /* PATTERN does not contain any wild cards. */ 810 return Qnil; 811 812 if (!CONSP (Vcached_fontset_data) 813 || strcmp (SDATA (pattern), CACHED_FONTSET_NAME)) 814 { 815 /* We must at first update the cached data. */ 816 unsigned char *regex, *p0, *p1; 817 int ndashes = 0, nstars = 0; 818 819 for (p0 = SDATA (pattern); *p0; p0++) 820 { 821 if (*p0 == '-') 822 ndashes++; 823 else if (*p0 == '*') 824 nstars++; 825 } 826 827 /* If PATTERN is not full XLFD we conert "*" to ".*". Otherwise 828 we convert "*" to "[^-]*" which is much faster in regular 829 expression matching. */ 830 if (ndashes < 14) 831 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 1); 832 else 833 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 1); 834 835 *p1++ = '^'; 836 for (p0 = SDATA (pattern); *p0; p0++) 837 { 838 if (*p0 == '*') 839 { 840 if (ndashes < 14) 841 *p1++ = '.'; 842 else 843 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']'; 844 *p1++ = '*'; 845 } 846 else if (*p0 == '?') 847 *p1++ = '.'; 848 else 849 *p1++ = *p0; 850 } 851 *p1++ = '$'; 852 *p1++ = 0; 853 854 Vcached_fontset_data = Fcons (build_string (SDATA (pattern)), 855 build_string (regex)); 856 } 857 858 return CACHED_FONTSET_REGEX; 859} 860 861/* Return ID of the base fontset named NAME. If there's no such 862 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this: 863 0: pattern containing '*' and '?' as wildcards 864 1: regular expression 865 2: literal fontset name 866*/ 867 868int 869fs_query_fontset (name, name_pattern) 870 Lisp_Object name; 871 int name_pattern; 872{ 873 Lisp_Object tem; 874 int i; 875 876 name = Fdowncase (name); 877 if (name_pattern != 1) 878 { 879 tem = Frassoc (name, Vfontset_alias_alist); 880 if (CONSP (tem) && STRINGP (XCAR (tem))) 881 name = XCAR (tem); 882 else if (name_pattern == 0) 883 { 884 tem = fontset_pattern_regexp (name); 885 if (STRINGP (tem)) 886 { 887 name = tem; 888 name_pattern = 1; 889 } 890 } 891 } 892 893 for (i = 0; i < ASIZE (Vfontset_table); i++) 894 { 895 Lisp_Object fontset, this_name; 896 897 fontset = FONTSET_FROM_ID (i); 898 if (NILP (fontset) 899 || !BASE_FONTSET_P (fontset)) 900 continue; 901 902 this_name = FONTSET_NAME (fontset); 903 if (name_pattern == 1 904 ? fast_string_match (name, this_name) >= 0 905 : !strcmp (SDATA (name), SDATA (this_name))) 906 return i; 907 } 908 return -1; 909} 910 911 912DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0, 913 doc: /* Return the name of a fontset that matches PATTERN. 914The value is nil if there is no matching fontset. 915PATTERN can contain `*' or `?' as a wildcard 916just as X font name matching algorithm allows. 917If REGEXPP is non-nil, PATTERN is a regular expression. */) 918 (pattern, regexpp) 919 Lisp_Object pattern, regexpp; 920{ 921 Lisp_Object fontset; 922 int id; 923 924 (*check_window_system_func) (); 925 926 CHECK_STRING (pattern); 927 928 if (SCHARS (pattern) == 0) 929 return Qnil; 930 931 id = fs_query_fontset (pattern, !NILP (regexpp)); 932 if (id < 0) 933 return Qnil; 934 935 fontset = FONTSET_FROM_ID (id); 936 return FONTSET_NAME (fontset); 937} 938 939/* Return a list of base fontset names matching PATTERN on frame F. 940 If SIZE is not 0, it is the size (maximum bound width) of fontsets 941 to be listed. */ 942 943Lisp_Object 944list_fontsets (f, pattern, size) 945 FRAME_PTR f; 946 Lisp_Object pattern; 947 int size; 948{ 949 Lisp_Object frame, regexp, val; 950 int id; 951 952 XSETFRAME (frame, f); 953 954 regexp = fontset_pattern_regexp (pattern); 955 val = Qnil; 956 957 for (id = 0; id < ASIZE (Vfontset_table); id++) 958 { 959 Lisp_Object fontset, name; 960 961 fontset = FONTSET_FROM_ID (id); 962 if (NILP (fontset) 963 || !BASE_FONTSET_P (fontset) 964 || !EQ (frame, FONTSET_FRAME (fontset))) 965 continue; 966 name = FONTSET_NAME (fontset); 967 968 if (!NILP (regexp) 969 ? (fast_string_match (regexp, name) < 0) 970 : strcmp (SDATA (pattern), SDATA (name))) 971 continue; 972 973 if (size) 974 { 975 struct font_info *fontp; 976 fontp = FS_LOAD_FONT (f, 0, NULL, id); 977 if (!fontp || size != fontp->size) 978 continue; 979 } 980 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val); 981 } 982 983 return val; 984} 985 986DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0, 987 doc: /* Create a new fontset NAME that contains font information in FONTLIST. 988FONTLIST is an alist of charsets vs corresponding font name patterns. */) 989 (name, fontlist) 990 Lisp_Object name, fontlist; 991{ 992 Lisp_Object fontset, elements, ascii_font; 993 Lisp_Object tem, tail, elt; 994 int id; 995 996 (*check_window_system_func) (); 997 998 CHECK_STRING (name); 999 CHECK_LIST (fontlist); 1000 1001 name = Fdowncase (name); 1002 id = fs_query_fontset (name, 2); 1003 if (id >= 0) 1004 { 1005 fontset = FONTSET_FROM_ID (id); 1006 tem = FONTSET_NAME (fontset); 1007 error ("Fontset `%s' matches the existing fontset `%s'", 1008 SDATA (name), SDATA (tem)); 1009 } 1010 1011 /* Check the validity of FONTLIST while creating a template for 1012 fontset elements. */ 1013 elements = ascii_font = Qnil; 1014 for (tail = fontlist; CONSP (tail); tail = XCDR (tail)) 1015 { 1016 int c, charset; 1017 1018 tem = XCAR (tail); 1019 if (!CONSP (tem) 1020 || (charset = get_charset_id (XCAR (tem))) < 0 1021 || (!STRINGP (XCDR (tem)) && !CONSP (XCDR (tem)))) 1022 error ("Elements of fontlist must be a cons of charset and font name pattern"); 1023 1024 tem = XCDR (tem); 1025 if (STRINGP (tem)) 1026 tem = Fdowncase (tem); 1027 else 1028 tem = Fcons (Fdowncase (Fcar (tem)), Fdowncase (Fcdr (tem))); 1029 if (charset == CHARSET_ASCII) 1030 ascii_font = tem; 1031 else 1032 { 1033 c = MAKE_CHAR (charset, 0, 0); 1034 elements = Fcons (Fcons (make_number (c), tem), elements); 1035 } 1036 } 1037 1038 if (NILP (ascii_font)) 1039 error ("No ASCII font in the fontlist"); 1040 1041 fontset = make_fontset (Qnil, name, Qnil); 1042 FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font); 1043 for (; CONSP (elements); elements = XCDR (elements)) 1044 { 1045 elt = XCAR (elements); 1046 tem = XCDR (elt); 1047 if (STRINGP (tem)) 1048 tem = font_family_registry (tem, 0); 1049 tem = Fcons (XCAR (elt), tem); 1050 FONTSET_SET (fontset, XINT (XCAR (elt)), tem); 1051 } 1052 1053 return Qnil; 1054} 1055 1056 1057/* Clear all elements of FONTSET for multibyte characters. */ 1058 1059static void 1060clear_fontset_elements (fontset) 1061 Lisp_Object fontset; 1062{ 1063 int i; 1064 1065 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++) 1066 XCHAR_TABLE (fontset)->contents[i] = Qnil; 1067} 1068 1069 1070/* Check validity of NAME as a fontset name and return the 1071 corresponding fontset. If not valid, signal an error. 1072 If NAME is nil, return Vdefault_fontset. */ 1073 1074static Lisp_Object 1075check_fontset_name (name) 1076 Lisp_Object name; 1077{ 1078 int id; 1079 1080 if (EQ (name, Qnil)) 1081 return Vdefault_fontset; 1082 1083 CHECK_STRING (name); 1084 /* First try NAME as literal. */ 1085 id = fs_query_fontset (name, 2); 1086 if (id < 0) 1087 /* For backward compatibility, try again NAME as pattern. */ 1088 id = fs_query_fontset (name, 0); 1089 if (id < 0) 1090 error ("Fontset `%s' does not exist", SDATA (name)); 1091 return FONTSET_FROM_ID (id); 1092} 1093 1094/* Downcase FONTNAME or car and cdr of FONTNAME. If FONTNAME is a 1095 string, maybe change FONTNAME to (FAMILY . REGISTRY). */ 1096 1097static Lisp_Object 1098regularize_fontname (Lisp_Object fontname) 1099{ 1100 Lisp_Object family, registry; 1101 1102 if (STRINGP (fontname)) 1103 return font_family_registry (Fdowncase (fontname), 0); 1104 1105 CHECK_CONS (fontname); 1106 family = XCAR (fontname); 1107 registry = XCDR (fontname); 1108 if (!NILP (family)) 1109 { 1110 CHECK_STRING (family); 1111 family = Fdowncase (family); 1112 } 1113 if (!NILP (registry)) 1114 { 1115 CHECK_STRING (registry); 1116 registry = Fdowncase (registry); 1117 } 1118 return Fcons (family, registry); 1119} 1120 1121DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0, 1122 doc: /* Modify fontset NAME to use FONTNAME for CHARACTER. 1123 1124If NAME is nil, modify the default fontset. 1125CHARACTER may be a cons; (FROM . TO), where FROM and TO are 1126non-generic characters. In that case, use FONTNAME 1127for all characters in the range FROM and TO (inclusive). 1128CHARACTER may be a charset. In that case, use FONTNAME 1129for all character in the charsets. 1130 1131FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family 1132name of a font, REGISTRY is a registry name of a font. */) 1133 (name, character, fontname, frame) 1134 Lisp_Object name, character, fontname, frame; 1135{ 1136 Lisp_Object fontset, elt; 1137 Lisp_Object realized; 1138 int from, to; 1139 int id; 1140 1141 fontset = check_fontset_name (name); 1142 1143 if (CONSP (character)) 1144 { 1145 /* CH should be (FROM . TO) where FROM and TO are non-generic 1146 characters. */ 1147 CHECK_NUMBER_CAR (character); 1148 CHECK_NUMBER_CDR (character); 1149 from = XINT (XCAR (character)); 1150 to = XINT (XCDR (character)); 1151 if (!char_valid_p (from, 0) || !char_valid_p (to, 0)) 1152 error ("Character range should be by non-generic characters"); 1153 if (!NILP (name) 1154 && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to))) 1155 error ("Can't change font for a single byte character"); 1156 } 1157 else if (SYMBOLP (character)) 1158 { 1159 elt = Fget (character, Qcharset); 1160 if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0))) 1161 error ("Invalid charset: %s", SDATA (SYMBOL_NAME (character))); 1162 from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0); 1163 to = from; 1164 } 1165 else 1166 { 1167 CHECK_NUMBER (character); 1168 from = XINT (character); 1169 to = from; 1170 } 1171 if (!char_valid_p (from, 1)) 1172 invalid_character (from); 1173 if (SINGLE_BYTE_CHAR_P (from)) 1174 error ("Can't change font for a single byte character"); 1175 if (from < to) 1176 { 1177 if (!char_valid_p (to, 1)) 1178 invalid_character (to); 1179 if (SINGLE_BYTE_CHAR_P (to)) 1180 error ("Can't change font for a single byte character"); 1181 } 1182 1183 /* The arg FRAME is kept for backward compatibility. We only check 1184 the validity. */ 1185 if (!NILP (frame)) 1186 CHECK_LIVE_FRAME (frame); 1187 1188 elt = Fcons (make_number (from), regularize_fontname (fontname)); 1189 for (; from <= to; from++) 1190 FONTSET_SET (fontset, from, elt); 1191 Foptimize_char_table (fontset); 1192 1193 /* If there's a realized fontset REALIZED whose parent is FONTSET, 1194 clear all the elements of REALIZED and free all multibyte faces 1195 whose fontset is REALIZED. This way, the specified character(s) 1196 are surely redisplayed by a correct font. */ 1197 for (id = 0; id < ASIZE (Vfontset_table); id++) 1198 { 1199 realized = AREF (Vfontset_table, id); 1200 if (!NILP (realized) 1201 && !BASE_FONTSET_P (realized) 1202 && EQ (FONTSET_BASE (realized), fontset)) 1203 { 1204 FRAME_PTR f = XFRAME (FONTSET_FRAME (realized)); 1205 clear_fontset_elements (realized); 1206 free_realized_multibyte_face (f, id); 1207 } 1208 } 1209 1210 return Qnil; 1211} 1212 1213DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0, 1214 doc: /* Return information about a font named NAME on frame FRAME. 1215If FRAME is omitted or nil, use the selected frame. 1216The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE, 1217 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT, 1218where 1219 OPENED-NAME is the name used for opening the font, 1220 FULL-NAME is the full name of the font, 1221 SIZE is the maximum bound width of the font, 1222 HEIGHT is the height of the font, 1223 BASELINE-OFFSET is the upward offset pixels from ASCII baseline, 1224 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling 1225 how to compose characters. 1226If the named font is not yet loaded, return nil. */) 1227 (name, frame) 1228 Lisp_Object name, frame; 1229{ 1230 FRAME_PTR f; 1231 struct font_info *fontp; 1232 Lisp_Object info; 1233 1234 (*check_window_system_func) (); 1235 1236 CHECK_STRING (name); 1237 name = Fdowncase (name); 1238 if (NILP (frame)) 1239 frame = selected_frame; 1240 CHECK_LIVE_FRAME (frame); 1241 f = XFRAME (frame); 1242 1243 if (!query_font_func) 1244 error ("Font query function is not supported"); 1245 1246 fontp = (*query_font_func) (f, SDATA (name)); 1247 if (!fontp) 1248 return Qnil; 1249 1250 info = Fmake_vector (make_number (7), Qnil); 1251 1252 XVECTOR (info)->contents[0] = build_string (fontp->name); 1253 XVECTOR (info)->contents[1] = build_string (fontp->full_name); 1254 XVECTOR (info)->contents[2] = make_number (fontp->size); 1255 XVECTOR (info)->contents[3] = make_number (fontp->height); 1256 XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset); 1257 XVECTOR (info)->contents[5] = make_number (fontp->relative_compose); 1258 XVECTOR (info)->contents[6] = make_number (fontp->default_ascent); 1259 1260 return info; 1261} 1262 1263 1264/* Return a cons (FONT-NAME . GLYPH-CODE). 1265 FONT-NAME is the font name for the character at POSITION in the current 1266 buffer. This is computed from all the text properties and overlays 1267 that apply to POSITION. POSTION may be nil, in which case, 1268 FONT-NAME is the font name for display the character CH with the 1269 default face. 1270 1271 GLYPH-CODE is the glyph code in the font to use for the character. 1272 1273 If the 2nd optional arg CH is non-nil, it is a character to check 1274 the font instead of the character at POSITION. 1275 1276 It returns nil in the following cases: 1277 1278 (1) The window system doesn't have a font for the character (thus 1279 it is displayed by an empty box). 1280 1281 (2) The character code is invalid. 1282 1283 (3) If POSITION is not nil, and the current buffer is not displayed 1284 in any window. 1285 1286 In addition, the returned font name may not take into account of 1287 such redisplay engine hooks as what used in jit-lock-mode if 1288 POSITION is currently not visible. */ 1289 1290 1291DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, 1292 doc: /* For internal use only. */) 1293 (position, ch) 1294 Lisp_Object position, ch; 1295{ 1296 int pos, pos_byte, dummy; 1297 int face_id; 1298 int c, code; 1299 struct frame *f; 1300 struct face *face; 1301 1302 if (NILP (position)) 1303 { 1304 CHECK_NATNUM (ch); 1305 c = XINT (ch); 1306 f = XFRAME (selected_frame); 1307 face_id = DEFAULT_FACE_ID; 1308 } 1309 else 1310 { 1311 Lisp_Object window; 1312 struct window *w; 1313 1314 CHECK_NUMBER_COERCE_MARKER (position); 1315 pos = XINT (position); 1316 if (pos < BEGV || pos >= ZV) 1317 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV)); 1318 pos_byte = CHAR_TO_BYTE (pos); 1319 if (NILP (ch)) 1320 c = FETCH_CHAR (pos_byte); 1321 else 1322 { 1323 CHECK_NATNUM (ch); 1324 c = XINT (ch); 1325 } 1326 window = Fget_buffer_window (Fcurrent_buffer (), Qnil); 1327 if (NILP (window)) 1328 return Qnil; 1329 w = XWINDOW (window); 1330 f = XFRAME (w->frame); 1331 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0); 1332 } 1333 if (! CHAR_VALID_P (c, 0)) 1334 return Qnil; 1335 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c); 1336 face = FACE_FROM_ID (f, face_id); 1337 if (! face->font || ! face->font_name) 1338 return Qnil; 1339 1340 { 1341 struct font_info *fontp = (*get_font_info_func) (f, face->font_info_id); 1342 XChar2b char2b; 1343 int c1, c2, charset; 1344 1345 SPLIT_CHAR (c, charset, c1, c2); 1346 if (c2 > 0) 1347 STORE_XCHAR2B (&char2b, c1, c2); 1348 else 1349 STORE_XCHAR2B (&char2b, 0, c1); 1350 rif->encode_char (c, &char2b, fontp, NULL); 1351 code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b); 1352 } 1353 return Fcons (build_string (face->font_name), make_number (code)); 1354} 1355 1356 1357/* Called from Ffontset_info via map_char_table on each leaf of 1358 fontset. ARG is a copy of the default fontset. The current leaf 1359 is indexed by CHARACTER and has value ELT. This function override 1360 the copy by ELT if ELT is not nil. */ 1361 1362static void 1363override_font_info (fontset, character, elt) 1364 Lisp_Object fontset, character, elt; 1365{ 1366 if (! NILP (elt)) 1367 Faset (fontset, character, elt); 1368} 1369 1370/* Called from Ffontset_info via map_char_table on each leaf of 1371 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last 1372 ARG)' and FONT-INFOs have this form: 1373 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC) 1374 The current leaf is indexed by CHARACTER and has value ELT. This 1375 function add the information of the current leaf to ARG by 1376 appending a new element or modifying the last element. */ 1377 1378static void 1379accumulate_font_info (arg, character, elt) 1380 Lisp_Object arg, character, elt; 1381{ 1382 Lisp_Object last, last_char, last_elt; 1383 1384 if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character))) 1385 elt = FONTSET_REF (Vdefault_fontset, XINT (character)); 1386 if (!CONSP (elt)) 1387 return; 1388 last = XCAR (arg); 1389 last_char = XCAR (XCAR (last)); 1390 last_elt = XCAR (XCDR (XCAR (last))); 1391 elt = XCDR (elt); 1392 if (!NILP (Fequal (elt, last_elt))) 1393 { 1394 int this_charset = CHAR_CHARSET (XINT (character)); 1395 1396 if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */ 1397 { 1398 if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char)))) 1399 { 1400 XSETCDR (last_char, character); 1401 return; 1402 } 1403 } 1404 else if (XINT (last_char) == XINT (character)) 1405 return; 1406 else if (this_charset == CHAR_CHARSET (XINT (last_char))) 1407 { 1408 XSETCAR (XCAR (last), Fcons (last_char, character)); 1409 return; 1410 } 1411 } 1412 XSETCDR (last, Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil)); 1413 XSETCAR (arg, XCDR (last)); 1414} 1415 1416 1417DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0, 1418 doc: /* Return information about a fontset named NAME on frame FRAME. 1419If NAME is nil, return information about the default fontset. 1420The value is a vector: 1421 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ], 1422where, 1423 SIZE is the maximum bound width of ASCII font in the fontset, 1424 HEIGHT is the maximum bound height of ASCII font in the fontset, 1425 CHARSET-OR-RANGE is a charset, a character (may be a generic character) 1426 or a cons of two characters specifying the range of characters. 1427 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY), 1428 where FAMILY is a `FAMILY' field of a XLFD font name, 1429 REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name. 1430 FAMILY may contain a `FOUNDRY' field at the head. 1431 REGISTRY may contain a `CHARSET_ENCODING' field at the tail. 1432 OPENEDs are names of fonts actually opened. 1433If the ASCII font is not yet opened, SIZE and HEIGHT are 0. 1434If FRAME is omitted, it defaults to the currently selected frame. */) 1435 (name, frame) 1436 Lisp_Object name, frame; 1437{ 1438 Lisp_Object fontset; 1439 FRAME_PTR f; 1440 Lisp_Object indices[3]; 1441 Lisp_Object val, tail, elt; 1442 Lisp_Object *realized; 1443 struct font_info *fontp = NULL; 1444 int n_realized = 0; 1445 int i; 1446 1447 (*check_window_system_func) (); 1448 1449 fontset = check_fontset_name (name); 1450 1451 if (NILP (frame)) 1452 frame = selected_frame; 1453 CHECK_LIVE_FRAME (frame); 1454 f = XFRAME (frame); 1455 1456 /* Recode realized fontsets whose base is FONTSET in the table 1457 `realized'. */ 1458 realized = (Lisp_Object *) alloca (sizeof (Lisp_Object) 1459 * ASIZE (Vfontset_table)); 1460 for (i = 0; i < ASIZE (Vfontset_table); i++) 1461 { 1462 elt = FONTSET_FROM_ID (i); 1463 if (!NILP (elt) 1464 && EQ (FONTSET_BASE (elt), fontset)) 1465 realized[n_realized++] = elt; 1466 } 1467 1468 if (! EQ (fontset, Vdefault_fontset)) 1469 { 1470 /* Merge FONTSET onto the default fontset. */ 1471 val = Fcopy_sequence (Vdefault_fontset); 1472 map_char_table (override_font_info, Qnil, fontset, fontset, val, 0, indices); 1473 fontset = val; 1474 } 1475 1476 /* Accumulate information of the fontset in VAL. The format is 1477 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE 1478 FONT-SPEC). See the comment for accumulate_font_info for the 1479 detail. */ 1480 val = Fcons (Fcons (make_number (0), 1481 Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)), 1482 Qnil); 1483 val = Fcons (val, val); 1484 map_char_table (accumulate_font_info, Qnil, fontset, fontset, val, 0, indices); 1485 val = XCDR (val); 1486 1487 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic 1488 character for a charset, replace it with the charset symbol. If 1489 fonts are opened for FONT-SPEC, append the names of the fonts to 1490 FONT-SPEC. */ 1491 for (tail = val; CONSP (tail); tail = XCDR (tail)) 1492 { 1493 int c; 1494 elt = XCAR (tail); 1495 if (INTEGERP (XCAR (elt))) 1496 { 1497 int charset, c1, c2; 1498 c = XINT (XCAR (elt)); 1499 SPLIT_CHAR (c, charset, c1, c2); 1500 if (c1 == 0) 1501 XSETCAR (elt, CHARSET_SYMBOL (charset)); 1502 } 1503 else 1504 c = XINT (XCAR (XCAR (elt))); 1505 for (i = 0; i < n_realized; i++) 1506 { 1507 Lisp_Object face_id, font; 1508 struct face *face; 1509 1510 face_id = FONTSET_REF_VIA_BASE (realized[i], c); 1511 if (INTEGERP (face_id)) 1512 { 1513 face = FACE_FROM_ID (f, XINT (face_id)); 1514 if (face && face->font && face->font_name) 1515 { 1516 font = build_string (face->font_name); 1517 if (NILP (Fmember (font, XCDR (XCDR (elt))))) 1518 XSETCDR (XCDR (elt), Fcons (font, XCDR (XCDR (elt)))); 1519 } 1520 } 1521 } 1522 } 1523 1524 elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val))); 1525 if (CONSP (elt)) 1526 { 1527 elt = XCAR (elt); 1528 fontp = (*query_font_func) (f, SDATA (elt)); 1529 } 1530 val = Fmake_vector (make_number (3), val); 1531 AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0); 1532 AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0); 1533 return val; 1534} 1535 1536DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0, 1537 doc: /* Return a font name pattern for character CH in fontset NAME. 1538If NAME is nil, find a font name pattern in the default fontset. */) 1539 (name, ch) 1540 Lisp_Object name, ch; 1541{ 1542 int c; 1543 Lisp_Object fontset, elt; 1544 1545 fontset = check_fontset_name (name); 1546 1547 CHECK_NUMBER (ch); 1548 c = XINT (ch); 1549 if (!char_valid_p (c, 1)) 1550 invalid_character (c); 1551 1552 elt = FONTSET_REF (fontset, c); 1553 if (CONSP (elt)) 1554 elt = XCDR (elt); 1555 1556 return elt; 1557} 1558 1559DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0, 1560 doc: /* Return a list of all defined fontset names. */) 1561 () 1562{ 1563 Lisp_Object fontset, list; 1564 int i; 1565 1566 list = Qnil; 1567 for (i = 0; i < ASIZE (Vfontset_table); i++) 1568 { 1569 fontset = FONTSET_FROM_ID (i); 1570 if (!NILP (fontset) 1571 && BASE_FONTSET_P (fontset)) 1572 list = Fcons (FONTSET_NAME (fontset), list); 1573 } 1574 1575 return list; 1576} 1577 1578DEFUN ("set-overriding-fontspec-internal", Fset_overriding_fontspec_internal, 1579 Sset_overriding_fontspec_internal, 1, 1, 0, 1580 doc: /* Internal use only. 1581 1582FONTLIST is an alist of TARGET vs FONTNAME, where TARGET is a charset 1583or a char-table, FONTNAME have the same meanings as in 1584`set-fontset-font'. 1585 1586It overrides the font specifications for each TARGET in the default 1587fontset by the corresponding FONTNAME. 1588 1589If TARGET is a charset, targets are all characters in the charset. If 1590TARGET is a char-table, targets are characters whose value is non-nil 1591in the table. 1592 1593It is intended that this function is called only from 1594`set-language-environment'. */) 1595 (fontlist) 1596 Lisp_Object fontlist; 1597{ 1598 Lisp_Object tail; 1599 1600 fontlist = Fcopy_sequence (fontlist); 1601 /* Now FONTLIST is ((TARGET . FONTNAME) ...). Reform it to ((TARGET 1602 nil nil nil FONTSPEC) ...), where TARGET is a charset-id or a 1603 char-table. */ 1604 for (tail = fontlist; CONSP (tail); tail = XCDR (tail)) 1605 { 1606 Lisp_Object elt, target; 1607 1608 elt = XCAR (tail); 1609 target = Fcar (elt); 1610 elt = Fcons (Qnil, regularize_fontname (Fcdr (elt))); 1611 if (! CHAR_TABLE_P (target)) 1612 { 1613 int charset, c; 1614 1615 CHECK_SYMBOL (target); 1616 charset = get_charset_id (target); 1617 if (charset < 0) 1618 error ("Invalid charset %s", SDATA (SYMBOL_NAME (target))); 1619 target = make_number (charset); 1620 c = MAKE_CHAR (charset, 0, 0); 1621 XSETCAR (elt, make_number (c)); 1622 } 1623 elt = Fcons (target, Fcons (Qnil, Fcons (Qnil, elt))); 1624 XSETCAR (tail, elt); 1625 } 1626 if (! NILP (Fequal (fontlist, Voverriding_fontspec_alist))) 1627 return Qnil; 1628 Voverriding_fontspec_alist = fontlist; 1629 clear_face_cache (0); 1630 ++windows_or_buffers_changed; 1631 return Qnil; 1632} 1633 1634void 1635syms_of_fontset () 1636{ 1637 if (!load_font_func) 1638 /* Window system initializer should have set proper functions. */ 1639 abort (); 1640 1641 Qfontset = intern ("fontset"); 1642 staticpro (&Qfontset); 1643 Fput (Qfontset, Qchar_table_extra_slots, make_number (3)); 1644 1645 Vcached_fontset_data = Qnil; 1646 staticpro (&Vcached_fontset_data); 1647 1648 Vfontset_table = Fmake_vector (make_number (32), Qnil); 1649 staticpro (&Vfontset_table); 1650 1651 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil); 1652 staticpro (&Vdefault_fontset); 1653 FONTSET_ID (Vdefault_fontset) = make_number (0); 1654 FONTSET_NAME (Vdefault_fontset) 1655 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"); 1656 AREF (Vfontset_table, 0) = Vdefault_fontset; 1657 next_fontset_id = 1; 1658 1659 Voverriding_fontspec_alist = Qnil; 1660 staticpro (&Voverriding_fontspec_alist); 1661 1662 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist, 1663 doc: /* Alist of fontname patterns vs corresponding encoding info. 1664Each element looks like (REGEXP . ENCODING-INFO), 1665 where ENCODING-INFO is an alist of CHARSET vs ENCODING. 1666ENCODING is one of the following integer values: 1667 0: code points 0x20..0x7F or 0x2020..0x7F7F are used, 1668 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used, 1669 2: code points 0x20A0..0x7FFF are used, 1670 3: code points 0xA020..0xFF7F are used. */); 1671 Vfont_encoding_alist = Qnil; 1672 Vfont_encoding_alist 1673 = Fcons (Fcons (build_string ("JISX0201"), 1674 Fcons (Fcons (intern ("latin-jisx0201"), make_number (0)), 1675 Qnil)), 1676 Vfont_encoding_alist); 1677 Vfont_encoding_alist 1678 = Fcons (Fcons (build_string ("ISO8859-1"), 1679 Fcons (Fcons (intern ("ascii"), make_number (0)), 1680 Qnil)), 1681 Vfont_encoding_alist); 1682 1683 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent, 1684 doc: /* Char table of characters whose ascent values should be ignored. 1685If an entry for a character is non-nil, the ascent value of the glyph 1686is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font. 1687 1688This affects how a composite character which contains 1689such a character is displayed on screen. */); 1690 Vuse_default_ascent = Qnil; 1691 1692 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition, 1693 doc: /* Char table of characters which is not composed relatively. 1694If an entry for a character is non-nil, a composition sequence 1695which contains that character is displayed so that 1696the glyph of that character is put without considering 1697an ascent and descent value of a previous character. */); 1698 Vignore_relative_composition = Qnil; 1699 1700 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist, 1701 doc: /* Alist of fontname vs list of the alternate fontnames. 1702When a specified font name is not found, the corresponding 1703alternate fontnames (if any) are tried instead. */); 1704 Valternate_fontname_alist = Qnil; 1705 1706 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist, 1707 doc: /* Alist of fontset names vs the aliases. */); 1708 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset), 1709 build_string ("fontset-default")), 1710 Qnil); 1711 1712 DEFVAR_LISP ("vertical-centering-font-regexp", 1713 &Vvertical_centering_font_regexp, 1714 doc: /* *Regexp matching font names that require vertical centering on display. 1715When a character is displayed with such fonts, the character is displayed 1716at the vertical center of lines. */); 1717 Vvertical_centering_font_regexp = Qnil; 1718 1719 defsubr (&Squery_fontset); 1720 defsubr (&Snew_fontset); 1721 defsubr (&Sset_fontset_font); 1722 defsubr (&Sfont_info); 1723 defsubr (&Sinternal_char_font); 1724 defsubr (&Sfontset_info); 1725 defsubr (&Sfontset_font); 1726 defsubr (&Sfontset_list); 1727 defsubr (&Sset_overriding_fontspec_internal); 1728} 1729 1730/* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537 1731 (do not change this comment) */ 1732