1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
25 When using Emacs with X, the display style of characters can be
26 changed by defining `faces'. Each face can specify the following
29 1. Font family or fontset alias name.
31 2. Relative proportionate width, aka character set width or set
32 width (swidth), e.g. `semi-compressed'.
34 3. Font height in 1/10pt
36 4. Font weight, e.g. `bold'.
38 5. Font slant, e.g. `italic'.
44 8. Whether or not characters should be underlined, and in what color.
46 9. Whether or not characters should be displayed in inverse video.
48 10. A background stipple, a bitmap.
50 11. Whether or not characters should be overlined, and in what color.
52 12. Whether or not characters should be strike-through, and in what
55 13. Whether or not a box should be drawn around characters, the box
56 type, and, for simple boxes, in what color.
58 Faces are frame-local by nature because Emacs allows to define the
59 same named face (face names are symbols) differently for different
60 frames. Each frame has an alist of face definitions for all named
61 faces. The value of a named face in such an alist is a Lisp vector
62 with the symbol `face' in slot 0, and a slot for each each of the
63 face attributes mentioned above.
65 There is also a global face alist `Vface_new_frame_defaults'. Face
66 definitions from this list are used to initialize faces of newly
69 A face doesn't have to specify all attributes. Those not specified
70 have a value of `unspecified'. Faces specifying all attributes are
71 called `fully-specified'.
76 The display style of a given character in the text is determined by
77 combining several faces. This process is called `face merging'.
78 Any aspect of the display style that isn't specified by overlays or
79 text properties is taken from the `default' face. Since it is made
80 sure that the default face is always fully-specified, face merging
81 always results in a fully-specified face.
86 After all face attributes for a character have been determined by
87 merging faces of that character, that face is `realized'. The
88 realization process maps face attributes to what is physically
89 available on the system where Emacs runs. The result is a
90 `realized face' in form of a struct face which is stored in the
91 face cache of the frame on which it was realized.
93 Face realization is done in the context of the charset of the
94 character to display because different fonts and encodings are used
95 for different charsets. In other words, for characters of
96 different charsets, different realized faces are needed to display
99 Faces are always realized for a specific character set and contain
100 a specific font, even if the face being realized specifies a
101 fontset (see `font selection' below). The reason is that the
102 result of the new font selection stage is better than what can be
103 done with statically defined font name patterns in fontsets.
108 In unibyte text, Emacs' charsets aren't applicable; function
109 `char-charset' reports CHARSET_ASCII for all characters, including
110 those > 0x7f. The X registry and encoding of fonts to use is
111 determined from the variable `x-unibyte-registry-and-encoding' in
112 this case. The variable is initialized at Emacs startup time from
113 the font the user specified for Emacs.
115 Currently all unibyte text, i.e. all buffers with
116 enable_multibyte_characters nil are displayed with fonts of the
117 same registry and encoding `x-unibyte-registry-and-encoding'. This
118 is consistent with the fact that languages can also be set
124 Font selection tries to find the best available matching font for a
125 given (charset, face) combination. This is done slightly
126 differently for faces specifying a fontset, or a font family name.
128 If the face specifies a fontset alias name, that fontset determines
129 a pattern for fonts of the given charset. If the face specifies a
130 font family, a font pattern is constructed. Charset symbols have a
131 property `x-charset-registry' for that purpose that maps a charset
132 to an XLFD registry and encoding in the font pattern constructed.
134 Available fonts on the system on which Emacs runs are then matched
135 against the font pattern. The result of font selection is the best
136 match for the given face attributes in this font list.
138 Font selection can be influenced by the user.
140 1. The user can specify the relative importance he gives the face
141 attributes width, height, weight, and slant by setting
142 face-font-selection-order (faces.el) to a list of face attribute
143 names. The default is '(:width :height :weight :slant), and means
144 that font selection first tries to find a good match for the font
145 width specified by a face, then---within fonts with that
146 width---tries to find a best match for the specified font height,
149 2. Setting face-alternative-font-family-alist allows the user to
150 specify alternative font families to try if a family specified by a
154 Composite characters.
156 Realized faces for composite characters are the only ones having a
157 fontset id >= 0. When a composite character is encoded into a
158 sequence of non-composite characters (in xterm.c), a suitable font
159 for the non-composite characters is then selected and realized,
160 i.e. the realization process is delayed but in principle the same.
163 Initialization of basic faces.
165 The faces `default', `modeline' are considered `basic faces'.
166 When redisplay happens the first time for a newly created frame,
167 basic faces are realized for CHARSET_ASCII. Frame parameters are
168 used to fill in unspecified attributes of the default face. */
170 /* Define SCALABLE_FONTS to a non-zero value to enable scalable
171 font use. Define it to zero to disable scalable font use.
173 Use of too many or too large scalable fonts can crash XFree86
174 servers. That's why I've put the code dealing with scalable fonts
177 #define SCALABLE_FONTS 1
180 #include <sys/types.h>
181 #include <sys/stat.h>
186 #ifdef HAVE_X_WINDOWS
191 #include <Xm/XmStrDefs.h>
192 #endif /* USE_MOTIF */
200 #include "dispextern.h"
201 #include "blockinput.h"
203 #include "intervals.h"
205 #ifdef HAVE_X_WINDOWS
207 /* Compensate for a bug in Xos.h on some systems, on which it requires
208 time.h. On some such systems, Xos.h tries to redefine struct
209 timeval and struct timezone if USG is #defined while it is
212 #ifdef XOS_NEEDS_TIME_H
218 #else /* not XOS_NEEDS_TIME_H */
220 #endif /* not XOS_NEEDS_TIME_H */
222 #endif /* HAVE_X_WINDOWS */
226 #include "keyboard.h"
229 #define max(A, B) ((A) > (B) ? (A) : (B))
230 #define min(A, B) ((A) < (B) ? (A) : (B))
231 #define abs(X) ((X) < 0 ? -(X) : (X))
234 /* Non-zero if face attribute ATTR is unspecified. */
236 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
238 /* Value is the number of elements of VECTOR. */
240 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
242 /* Make a copy of string S on the stack using alloca. Value is a pointer
245 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
247 /* Make a copy of the contents of Lisp string S on the stack using
248 alloca. Value is a pointer to the copy. */
250 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
252 /* Size of hash table of realized faces in face caches (should be a
255 #define FACE_CACHE_BUCKETS_SIZE 1001
257 /* A definition of XColor for non-X frames. */
258 #ifndef HAVE_X_WINDOWS
261 unsigned short red
, green
, blue
;
267 /* Keyword symbols used for face attribute names. */
269 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
270 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
271 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
272 Lisp_Object QCreverse_video
;
273 Lisp_Object QCoverline
, QCstrike_through
, QCbox
;
275 /* Symbols used for attribute values. */
277 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
278 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
279 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
280 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
281 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
282 Lisp_Object Qultra_expanded
;
283 Lisp_Object Qreleased_button
, Qpressed_button
;
284 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
285 Lisp_Object Qunspecified
;
287 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
289 /* The symbol `x-charset-registry'. This property of charsets defines
290 the X registry and encoding that fonts should have that are used to
291 display characters of that charset. */
293 Lisp_Object Qx_charset_registry
;
295 /* The name of the function to call when the background of the frame
296 has changed, frame_update_face_colors. */
298 Lisp_Object Qframe_update_face_colors
;
300 /* Names of basic faces. */
302 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
303 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
304 extern Lisp_Object Qmode_line
;
306 /* The symbol `face-alias'. A symbols having that property is an
307 alias for another face. Value of the property is the name of
310 Lisp_Object Qface_alias
;
312 /* Names of frame parameters related to faces. */
314 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
315 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
317 /* Default stipple pattern used on monochrome displays. This stipple
318 pattern is used on monochrome displays instead of shades of gray
319 for a face background color. See `set-face-stipple' for possible
320 values for this variable. */
322 Lisp_Object Vface_default_stipple
;
324 /* Default registry and encoding to use for charsets whose charset
325 symbols don't specify one. */
327 Lisp_Object Vface_default_registry
;
329 /* Alist of alternative font families. Each element is of the form
330 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
331 try FAMILY1, then FAMILY2, ... */
333 Lisp_Object Vface_alternative_font_family_alist
;
335 /* Allowed scalable fonts. A value of nil means don't allow any
336 scalable fonts. A value of t means allow the use of any scalable
337 font. Otherwise, value must be a list of regular expressions. A
338 font may be scaled if its name matches a regular expression in the
342 Lisp_Object Vscalable_fonts_allowed
;
345 /* Maximum number of fonts to consider in font_list. If not an
346 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
348 Lisp_Object Vfont_list_limit
;
349 #define DEFAULT_FONT_LIST_LIMIT 100
351 /* The symbols `foreground-color' and `background-color' which can be
352 used as part of a `face' property. This is for compatibility with
355 Lisp_Object Qforeground_color
, Qbackground_color
;
357 /* The symbols `face' and `mouse-face' used as text properties. */
360 extern Lisp_Object Qmouse_face
;
362 /* Error symbol for wrong_type_argument in load_pixmap. */
364 Lisp_Object Qbitmap_spec_p
;
366 /* Alist of global face definitions. Each element is of the form
367 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
368 is a Lisp vector of face attributes. These faces are used
369 to initialize faces for new frames. */
371 Lisp_Object Vface_new_frame_defaults
;
373 /* The next ID to assign to Lisp faces. */
375 static int next_lface_id
;
377 /* A vector mapping Lisp face Id's to face names. */
379 static Lisp_Object
*lface_id_to_name
;
380 static int lface_id_to_name_size
;
382 /* tty color-related functions (defined on lisp/term/tty-colors.el). */
383 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
385 /* Counter for calls to clear_face_cache. If this counter reaches
386 CLEAR_FONT_TABLE_COUNT, and a frame has more than
387 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
389 static int clear_font_table_count
;
390 #define CLEAR_FONT_TABLE_COUNT 100
391 #define CLEAR_FONT_TABLE_NFONTS 10
393 /* Non-zero means face attributes have been changed since the last
394 redisplay. Used in redisplay_internal. */
396 int face_change_count
;
398 /* The total number of colors currently allocated. */
401 static int ncolors_allocated
;
402 static int npixmaps_allocated
;
408 /* Function prototypes. */
413 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
414 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
415 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
416 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
418 static int first_font_matching
P_ ((struct frame
*f
, char *,
419 struct font_name
*));
420 static int x_face_list_fonts
P_ ((struct frame
*, char *,
421 struct font_name
*, int, int, int));
422 static int font_scalable_p
P_ ((struct font_name
*));
423 static Lisp_Object deduce_unibyte_registry
P_ ((struct frame
*, char *));
424 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
425 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
426 static char *xstrdup
P_ ((char *));
427 static unsigned char *xstrlwr
P_ ((unsigned char *));
428 static void signal_error
P_ ((char *, Lisp_Object
));
429 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
430 static void load_face_font_or_fontset
P_ ((struct frame
*, struct face
*, char *, int));
431 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
432 static void free_face_colors
P_ ((struct frame
*, struct face
*));
433 static int face_color_gray_p
P_ ((struct frame
*, char *));
434 static char *build_font_name
P_ ((struct font_name
*));
435 static void free_font_names
P_ ((struct font_name
*, int));
436 static int sorted_font_list
P_ ((struct frame
*, char *,
437 int (*cmpfn
) P_ ((const void *, const void *)),
438 struct font_name
**));
439 static int font_list
P_ ((struct frame
*, char *, char *, char *, struct font_name
**));
440 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, char *, char *, char *,
441 struct font_name
**));
442 static int cmp_font_names
P_ ((const void *, const void *));
443 static struct face
*realize_face
P_ ((struct face_cache
*,
444 Lisp_Object
*, int));
445 static struct face
*realize_x_face
P_ ((struct face_cache
*,
446 Lisp_Object
*, int));
447 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
448 Lisp_Object
*, int));
449 static int realize_basic_faces
P_ ((struct frame
*));
450 static int realize_default_face
P_ ((struct frame
*));
451 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
452 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
453 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
454 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
455 static unsigned lface_hash
P_ ((Lisp_Object
*));
456 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
457 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
458 static void free_realized_face
P_ ((struct frame
*, struct face
*));
459 static void clear_face_gcs
P_ ((struct face_cache
*));
460 static void free_face_cache
P_ ((struct face_cache
*));
461 static int face_numeric_weight
P_ ((Lisp_Object
));
462 static int face_numeric_slant
P_ ((Lisp_Object
));
463 static int face_numeric_swidth
P_ ((Lisp_Object
));
464 static int face_fontset
P_ ((struct frame
*, Lisp_Object
*));
465 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int,
467 static char *choose_face_fontset_font
P_ ((struct frame
*, Lisp_Object
*,
469 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
470 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
472 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
, char *,
474 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
475 static struct face
*make_realized_face
P_ ((Lisp_Object
*, int, Lisp_Object
));
476 static void free_realized_faces
P_ ((struct face_cache
*));
477 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
478 struct font_name
*, int));
479 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
480 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
481 static int xlfd_numeric_slant
P_ ((struct font_name
*));
482 static int xlfd_numeric_weight
P_ ((struct font_name
*));
483 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
484 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
485 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
486 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
487 static int xlfd_fixed_p
P_ ((struct font_name
*));
488 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
490 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
491 struct font_name
*, int, int));
492 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
493 struct font_name
*, int));
495 #ifdef HAVE_X_WINDOWS
497 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
498 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
499 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
500 int (*cmpfn
) P_ ((const void *, const void *))));
501 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
502 static void x_free_gc
P_ ((struct frame
*, GC
));
503 static void clear_font_table
P_ ((struct frame
*));
505 #endif /* HAVE_X_WINDOWS */
508 /***********************************************************************
510 ***********************************************************************/
512 #ifdef HAVE_X_WINDOWS
514 /* Create and return a GC for use on frame F. GC values and mask
515 are given by XGCV and MASK. */
518 x_create_gc (f
, mask
, xgcv
)
525 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
532 /* Free GC which was used on frame F. */
540 xassert (--ngcs
>= 0);
541 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
545 #endif /* HAVE_X_WINDOWS */
548 /* Like strdup, but uses xmalloc. */
554 int len
= strlen (s
) + 1;
555 char *p
= (char *) xmalloc (len
);
561 /* Like stricmp. Used to compare parts of font names which are in
566 unsigned char *s1
, *s2
;
570 unsigned char c1
= tolower (*s1
);
571 unsigned char c2
= tolower (*s2
);
573 return c1
< c2
? -1 : 1;
578 return *s2
== 0 ? 0 : -1;
583 /* Like strlwr, which might not always be available. */
585 static unsigned char *
589 unsigned char *p
= s
;
598 /* Signal `error' with message S, and additional argument ARG. */
601 signal_error (s
, arg
)
605 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
609 /* If FRAME is nil, return a pointer to the selected frame.
610 Otherwise, check that FRAME is a live frame, and return a pointer
611 to it. NPARAM is the parameter number of FRAME, for
612 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
613 Lisp function definitions. */
615 static INLINE
struct frame
*
616 frame_or_selected_frame (frame
, nparam
)
621 frame
= selected_frame
;
623 CHECK_LIVE_FRAME (frame
, nparam
);
624 return XFRAME (frame
);
628 /***********************************************************************
630 ***********************************************************************/
632 /* Initialize face cache and basic faces for frame F. */
638 /* Make a face cache, if F doesn't have one. */
639 if (FRAME_FACE_CACHE (f
) == NULL
)
640 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
642 #ifdef HAVE_X_WINDOWS
643 /* Make the image cache. */
646 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
647 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
648 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
650 #endif /* HAVE_X_WINDOWS */
652 /* Realize basic faces. Must have enough information in frame
653 parameters to realize basic faces at this point. */
654 #ifdef HAVE_X_WINDOWS
655 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
657 if (!realize_basic_faces (f
))
662 /* Free face cache of frame F. Called from Fdelete_frame. */
668 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
672 free_face_cache (face_cache
);
673 FRAME_FACE_CACHE (f
) = NULL
;
676 #ifdef HAVE_X_WINDOWS
679 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
682 --image_cache
->refcount
;
683 if (image_cache
->refcount
== 0)
684 free_image_cache (f
);
687 #endif /* HAVE_X_WINDOWS */
691 /* Clear face caches, and recompute basic faces for frame F. Call
692 this after changing frame parameters on which those faces depend,
693 or when realized faces have been freed due to changing attributes
697 recompute_basic_faces (f
)
700 if (FRAME_FACE_CACHE (f
))
702 clear_face_cache (0);
703 if (!realize_basic_faces (f
))
709 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
710 try to free unused fonts, too. */
713 clear_face_cache (clear_fonts_p
)
716 #ifdef HAVE_X_WINDOWS
717 Lisp_Object tail
, frame
;
721 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
723 /* From time to time see if we can unload some fonts. This also
724 frees all realized faces on all frames. Fonts needed by
725 faces will be loaded again when faces are realized again. */
726 clear_font_table_count
= 0;
728 FOR_EACH_FRAME (tail
, frame
)
732 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
734 free_all_realized_faces (frame
);
735 clear_font_table (f
);
741 /* Clear GCs of realized faces. */
742 FOR_EACH_FRAME (tail
, frame
)
747 clear_face_gcs (FRAME_FACE_CACHE (f
));
748 clear_image_cache (f
, 0);
752 #endif /* HAVE_X_WINDOWS */
756 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
757 "Clear face caches on all frames.\n\
758 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
760 Lisp_Object thorougly
;
762 clear_face_cache (!NILP (thorougly
));
768 #ifdef HAVE_X_WINDOWS
771 /* Remove those fonts from the font table of frame F that are not used
772 by fontsets. Called from clear_face_cache from time to time. */
778 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
780 Lisp_Object rest
, frame
;
783 xassert (FRAME_X_P (f
));
785 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
786 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
788 /* For all frames with the same x_display_info as F, record
789 in `used' those fonts that are in use by fontsets. */
790 FOR_EACH_FRAME (rest
, frame
)
791 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
793 struct frame
*f
= XFRAME (frame
);
794 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
796 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
798 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
801 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
803 int idx
= info
->font_indexes
[j
];
810 /* Free those fonts that are not used by fontsets. */
811 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
812 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
814 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
816 /* Free names. In xfns.c there is a comment that full_name
817 should never be freed because it is always shared with
818 something else. I don't think this is true anymore---see
819 x_load_font. It's either equal to font_info->name or
820 allocated via xmalloc, and there seems to be no place in
821 the source files where full_name is transferred to another
823 if (font_info
->full_name
!= font_info
->name
)
824 xfree (font_info
->full_name
);
825 xfree (font_info
->name
);
829 XFreeFont (dpyinfo
->display
, font_info
->font
);
832 /* Mark font table slot free. */
833 font_info
->font
= NULL
;
834 font_info
->name
= font_info
->full_name
= NULL
;
839 #endif /* HAVE_X_WINDOWS */
843 /***********************************************************************
845 ***********************************************************************/
847 #ifdef HAVE_X_WINDOWS
849 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
850 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
851 A bitmap specification is either a string, a file name, or a list\n\
852 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
853 HEIGHT is its height, and DATA is a string containing the bits of\n\
854 the pixmap. Bits are stored row by row, each row occupies\n\
855 (WIDTH + 7)/8 bytes.")
861 if (STRINGP (object
))
862 /* If OBJECT is a string, it's a file name. */
864 else if (CONSP (object
))
866 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
867 HEIGHT must be integers > 0, and DATA must be string large
868 enough to hold a bitmap of the specified size. */
869 Lisp_Object width
, height
, data
;
871 height
= width
= data
= Qnil
;
875 width
= XCAR (object
);
876 object
= XCDR (object
);
879 height
= XCAR (object
);
880 object
= XCDR (object
);
882 data
= XCAR (object
);
886 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
888 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
890 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* height
)
895 return pixmap_p
? Qt
: Qnil
;
899 /* Load a bitmap according to NAME (which is either a file name or a
900 pixmap spec) for use on frame F. Value is the bitmap_id (see
901 xfns.c). If NAME is nil, return with a bitmap id of zero. If
902 bitmap cannot be loaded, display a message saying so, and return
903 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
904 if these pointers are not null. */
907 load_pixmap (f
, name
, w_ptr
, h_ptr
)
910 unsigned int *w_ptr
, *h_ptr
;
918 tem
= Fbitmap_spec_p (name
);
920 wrong_type_argument (Qbitmap_spec_p
, name
);
925 /* Decode a bitmap spec into a bitmap. */
930 w
= XINT (Fcar (name
));
931 h
= XINT (Fcar (Fcdr (name
)));
932 bits
= Fcar (Fcdr (Fcdr (name
)));
934 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
939 /* It must be a string -- a file name. */
940 bitmap_id
= x_create_bitmap_from_file (f
, name
);
946 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
957 ++npixmaps_allocated
;
960 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
963 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
969 #endif /* HAVE_X_WINDOWS */
973 /***********************************************************************
975 ***********************************************************************/
977 #ifdef HAVE_X_WINDOWS
979 /* Update the line_height of frame F. Return non-zero if line height
983 frame_update_line_height (f
)
986 int fontset
, line_height
, changed_p
;
988 fontset
= f
->output_data
.x
->fontset
;
990 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
992 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
994 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
995 f
->output_data
.x
->line_height
= line_height
;
999 #endif /* HAVE_X_WINDOWS */
1002 /***********************************************************************
1004 ***********************************************************************/
1006 #ifdef HAVE_X_WINDOWS
1008 /* Load font or fontset of face FACE which is used on frame F.
1009 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1010 fontset. FONT_NAME is the name of the font to load, if no fontset
1011 is used. It is null if no suitable font name could be determined
1015 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1021 struct font_info
*font_info
= NULL
;
1023 face
->font_info_id
= -1;
1024 face
->fontset
= fontset
;
1029 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1032 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1041 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1042 face
->font
= font_info
->font
;
1043 face
->font_name
= font_info
->full_name
;
1045 /* Make the registry part of the font name readily accessible.
1046 The registry is used to find suitable faces for unibyte text. */
1047 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1049 while (i
< 2 && --s
>= font_info
->full_name
)
1053 if (!STRINGP (face
->registry
)
1054 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1056 if (STRINGP (Vface_default_registry
)
1057 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1058 face
->registry
= Vface_default_registry
;
1060 face
->registry
= build_string (s
+ 1);
1063 else if (fontset
>= 0)
1064 add_to_log ("Unable to load ASCII font of fontset %d",
1065 make_number (fontset
), Qnil
);
1067 add_to_log ("Unable to load font %s",
1068 build_string (font_name
), Qnil
);
1071 #endif /* HAVE_X_WINDOWS */
1075 /***********************************************************************
1077 ***********************************************************************/
1079 /* A version of defined_color for non-X frames. */
1081 tty_defined_color (f
, color_name
, color_def
, alloc
)
1087 Lisp_Object color_desc
;
1088 int color_idx
= FACE_TTY_DEFAULT_COLOR
, red
= 0, green
= 0, blue
= 0;
1091 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1095 XSETFRAME (frame
, f
);
1097 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1098 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1100 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1101 if (CONSP (XCDR (XCDR (color_desc
))))
1103 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1104 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1105 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1109 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1110 /* We were called early during startup, and the colors are not
1111 yet set up in tty-defined-color-alist. Don't return a failure
1112 indication, since this produces the annoying "Unable to
1113 load color" messages in the *Messages* buffer. */
1116 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1118 if (strcmp (color_name
, "unspecified-fg") == 0)
1119 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1120 else if (strcmp (color_name
, "unspecified-bg") == 0)
1121 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1124 color_def
->pixel
= (unsigned long) color_idx
;
1125 color_def
->red
= red
;
1126 color_def
->green
= green
;
1127 color_def
->blue
= blue
;
1132 /* Decide if color named COLOR is valid for the display associated
1133 with the frame F; if so, return the rgb values in COLOR_DEF. If
1134 ALLOC is nonzero, allocate a new colormap cell.
1136 This does the right thing for any type of frame. */
1138 defined_color (f
, color_name
, color_def
, alloc
)
1144 if (!FRAME_WINDOW_P (f
))
1145 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1146 #ifdef HAVE_X_WINDOWS
1147 else if (FRAME_X_P (f
))
1148 return x_defined_color (f
, color_name
, color_def
, alloc
);
1151 else if (FRAME_W32_P (f
))
1152 /* FIXME: w32_defined_color doesn't exist! w32fns.c defines
1153 defined_color which needs to be renamed, and the declaration
1154 of color_def therein should be changed. */
1155 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1158 else if (FRAME_MAC_P (f
))
1159 /* FIXME: mac_defined_color doesn't exist! */
1160 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1166 /* Given the index of the tty color, return its name, a Lisp string. */
1169 tty_color_name (f
, idx
)
1175 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1178 Lisp_Object coldesc
;
1180 XSETFRAME (frame
, f
);
1181 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1183 if (!NILP (coldesc
))
1184 return XCAR (coldesc
);
1187 /* We can have an MSDOG frame under -nw for a short window of
1188 opportunity before internal_terminal_init is called. DTRT. */
1189 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1190 return msdos_stdcolor_name (idx
);
1194 /* FIXME: When/if w32 supports colors in non-window mode, there should
1195 be a call here to a w32-specific function that returns the color
1196 by index using the default color mapping on a Windows console. */
1199 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1200 return build_string (unspecified_fg
);
1201 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1202 return build_string (unspecified_bg
);
1203 return Qunspecified
;
1206 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1207 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1210 face_color_gray_p (f
, color_name
)
1217 if (defined_color (f
, color_name
, &color
, 0))
1218 gray_p
= ((abs (color
.red
- color
.green
)
1219 < max (color
.red
, color
.green
) / 20)
1220 && (abs (color
.green
- color
.blue
)
1221 < max (color
.green
, color
.blue
) / 20)
1222 && (abs (color
.blue
- color
.red
)
1223 < max (color
.blue
, color
.red
) / 20));
1231 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1232 BACKGROUND_P non-zero means the color will be used as background
1236 face_color_supported_p (f
, color_name
, background_p
)
1244 XSETFRAME (frame
, f
);
1245 return (FRAME_WINDOW_P (f
)
1246 ? (!NILP (Fxw_display_color_p (frame
))
1247 || xstricmp (color_name
, "black") == 0
1248 || xstricmp (color_name
, "white") == 0
1250 && face_color_gray_p (f
, color_name
))
1251 || (!NILP (Fx_display_grayscale_p (frame
))
1252 && face_color_gray_p (f
, color_name
)))
1253 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1257 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1258 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1259 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1260 If FRAME is nil or omitted, use the selected frame.")
1262 Lisp_Object color
, frame
;
1266 CHECK_FRAME (frame
, 0);
1267 CHECK_STRING (color
, 0);
1269 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1273 DEFUN ("color-supported-p", Fcolor_supported_p
,
1274 Scolor_supported_p
, 2, 3, 0,
1275 "Return non-nil if COLOR can be displayed on FRAME.\n\
1276 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1277 If FRAME is nil or omitted, use the selected frame.\n\
1278 COLOR must be a valid color name.")
1279 (color
, frame
, background_p
)
1280 Lisp_Object frame
, color
, background_p
;
1284 CHECK_FRAME (frame
, 0);
1285 CHECK_STRING (color
, 0);
1287 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1292 /* Load color with name NAME for use by face FACE on frame F.
1293 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1294 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1295 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1296 pixel color. If color cannot be loaded, display a message, and
1297 return the foreground, background or underline color of F, but
1298 record that fact in flags of the face so that we don't try to free
1302 load_color (f
, face
, name
, target_index
)
1306 enum lface_attribute_index target_index
;
1310 xassert (STRINGP (name
));
1311 xassert (target_index
== LFACE_FOREGROUND_INDEX
1312 || target_index
== LFACE_BACKGROUND_INDEX
1313 || target_index
== LFACE_UNDERLINE_INDEX
1314 || target_index
== LFACE_OVERLINE_INDEX
1315 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1316 || target_index
== LFACE_BOX_INDEX
);
1318 /* if the color map is full, defined_color will return a best match
1319 to the values in an existing cell. */
1320 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1322 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1324 switch (target_index
)
1326 case LFACE_FOREGROUND_INDEX
:
1327 face
->foreground_defaulted_p
= 1;
1328 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1331 case LFACE_BACKGROUND_INDEX
:
1332 face
->background_defaulted_p
= 1;
1333 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1336 case LFACE_UNDERLINE_INDEX
:
1337 face
->underline_defaulted_p
= 1;
1338 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1341 case LFACE_OVERLINE_INDEX
:
1342 face
->overline_color_defaulted_p
= 1;
1343 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1346 case LFACE_STRIKE_THROUGH_INDEX
:
1347 face
->strike_through_color_defaulted_p
= 1;
1348 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1351 case LFACE_BOX_INDEX
:
1352 face
->box_color_defaulted_p
= 1;
1353 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1362 ++ncolors_allocated
;
1368 #ifdef HAVE_X_WINDOWS
1370 /* Load colors for face FACE which is used on frame F. Colors are
1371 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1372 of ATTRS. If the background color specified is not supported on F,
1373 try to emulate gray colors with a stipple from Vface_default_stipple. */
1376 load_face_colors (f
, face
, attrs
)
1383 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1384 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1386 /* Swap colors if face is inverse-video. */
1387 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1395 /* Check for support for foreground, not for background because
1396 face_color_supported_p is smart enough to know that grays are
1397 "supported" as background because we are supposed to use stipple
1399 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1400 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1402 x_destroy_bitmap (f
, face
->stipple
);
1403 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1404 &face
->pixmap_w
, &face
->pixmap_h
);
1407 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1408 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1412 /* Free color PIXEL on frame F. */
1415 unload_color (f
, pixel
)
1417 unsigned long pixel
;
1419 Display
*dpy
= FRAME_X_DISPLAY (f
);
1420 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1422 if (pixel
== BLACK_PIX_DEFAULT (f
)
1423 || pixel
== WHITE_PIX_DEFAULT (f
))
1428 /* If display has an immutable color map, freeing colors is not
1429 necessary and some servers don't allow it. So don't do it. */
1430 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1432 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1433 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1440 /* Free colors allocated for FACE. */
1443 free_face_colors (f
, face
)
1447 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1449 /* If display has an immutable color map, freeing colors is not
1450 necessary and some servers don't allow it. So don't do it. */
1451 if (class != StaticColor
1452 && class != StaticGray
1453 && class != TrueColor
)
1459 dpy
= FRAME_X_DISPLAY (f
);
1460 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1462 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1463 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1464 && !face
->foreground_defaulted_p
)
1466 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1467 IF_DEBUG (--ncolors_allocated
);
1470 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1471 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1472 && !face
->background_defaulted_p
)
1474 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1475 IF_DEBUG (--ncolors_allocated
);
1478 if (face
->underline_p
1479 && !face
->underline_defaulted_p
1480 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1481 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1483 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1484 IF_DEBUG (--ncolors_allocated
);
1487 if (face
->overline_p
1488 && !face
->overline_color_defaulted_p
1489 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1490 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1492 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1493 IF_DEBUG (--ncolors_allocated
);
1496 if (face
->strike_through_p
1497 && !face
->strike_through_color_defaulted_p
1498 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1499 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1501 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1502 IF_DEBUG (--ncolors_allocated
);
1505 if (face
->box
!= FACE_NO_BOX
1506 && !face
->box_color_defaulted_p
1507 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1508 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1510 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1511 IF_DEBUG (--ncolors_allocated
);
1517 #endif /* HAVE_X_WINDOWS */
1521 /***********************************************************************
1523 ***********************************************************************/
1525 /* An enumerator for each field of an XLFD font name. */
1546 /* An enumerator for each possible slant value of a font. Taken from
1547 the XLFD specification. */
1555 XLFD_SLANT_REVERSE_ITALIC
,
1556 XLFD_SLANT_REVERSE_OBLIQUE
,
1560 /* Relative font weight according to XLFD documentation. */
1564 XLFD_WEIGHT_UNKNOWN
,
1565 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1566 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1567 XLFD_WEIGHT_LIGHT
, /* 30 */
1568 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1569 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1570 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1571 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1572 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1573 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1576 /* Relative proportionate width. */
1580 XLFD_SWIDTH_UNKNOWN
,
1581 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1582 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1583 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1584 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1585 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1586 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1587 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1588 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1589 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1592 /* Structure used for tables mapping XLFD weight, slant, and width
1593 names to numeric and symbolic values. */
1599 Lisp_Object
*symbol
;
1602 /* Table of XLFD slant names and their numeric and symbolic
1603 representations. This table must be sorted by slant names in
1606 static struct table_entry slant_table
[] =
1608 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1609 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1610 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1611 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1612 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1613 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1616 /* Table of XLFD weight names. This table must be sorted by weight
1617 names in ascending order. */
1619 static struct table_entry weight_table
[] =
1621 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1622 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1623 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1624 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1625 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1626 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1627 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1628 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1629 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1630 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1631 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1632 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1633 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1634 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1635 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1638 /* Table of XLFD width names. This table must be sorted by width
1639 names in ascending order. */
1641 static struct table_entry swidth_table
[] =
1643 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1644 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1645 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1646 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1647 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1648 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1649 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1650 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1651 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1652 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1653 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1654 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1655 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1656 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1657 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1660 /* Structure used to hold the result of splitting font names in XLFD
1661 format into their fields. */
1665 /* The original name which is modified destructively by
1666 split_font_name. The pointer is kept here to be able to free it
1667 if it was allocated from the heap. */
1670 /* Font name fields. Each vector element points into `name' above.
1671 Fields are NUL-terminated. */
1672 char *fields
[XLFD_LAST
];
1674 /* Numeric values for those fields that interest us. See
1675 split_font_name for which these are. */
1676 int numeric
[XLFD_LAST
];
1679 /* The frame in effect when sorting font names. Set temporarily in
1680 sort_fonts so that it is available in font comparison functions. */
1682 static struct frame
*font_frame
;
1684 /* Order by which font selection chooses fonts. The default values
1685 mean `first, find a best match for the font width, then for the
1686 font height, then for weight, then for slant.' This variable can be
1687 set via set-face-font-sort-order. */
1689 static int font_sort_order
[4];
1692 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1693 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1694 is a pointer to the matching table entry or null if no table entry
1697 static struct table_entry
*
1698 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1699 struct table_entry
*table
;
1701 struct font_name
*font
;
1704 /* Function split_font_name converts fields to lower-case, so there
1705 is no need to use xstrlwr or xstricmp here. */
1706 char *s
= font
->fields
[field_index
];
1707 int low
, mid
, high
, cmp
;
1714 mid
= (low
+ high
) / 2;
1715 cmp
= strcmp (table
[mid
].name
, s
);
1729 /* Return a numeric representation for font name field
1730 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1731 has DIM entries. Value is the numeric value found or DFLT if no
1732 table entry matches. This function is used to translate weight,
1733 slant, and swidth names of XLFD font names to numeric values. */
1736 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1737 struct table_entry
*table
;
1739 struct font_name
*font
;
1743 struct table_entry
*p
;
1744 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1745 return p
? p
->numeric
: dflt
;
1749 /* Return a symbolic representation for font name field
1750 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1751 has DIM entries. Value is the symbolic value found or DFLT if no
1752 table entry matches. This function is used to translate weight,
1753 slant, and swidth names of XLFD font names to symbols. */
1755 static INLINE Lisp_Object
1756 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1757 struct table_entry
*table
;
1759 struct font_name
*font
;
1763 struct table_entry
*p
;
1764 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1765 return p
? *p
->symbol
: dflt
;
1769 /* Return a numeric value for the slant of the font given by FONT. */
1772 xlfd_numeric_slant (font
)
1773 struct font_name
*font
;
1775 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1776 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1780 /* Return a symbol representing the weight of the font given by FONT. */
1782 static INLINE Lisp_Object
1783 xlfd_symbolic_slant (font
)
1784 struct font_name
*font
;
1786 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1787 font
, XLFD_SLANT
, Qnormal
);
1791 /* Return a numeric value for the weight of the font given by FONT. */
1794 xlfd_numeric_weight (font
)
1795 struct font_name
*font
;
1797 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1798 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1802 /* Return a symbol representing the slant of the font given by FONT. */
1804 static INLINE Lisp_Object
1805 xlfd_symbolic_weight (font
)
1806 struct font_name
*font
;
1808 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1809 font
, XLFD_WEIGHT
, Qnormal
);
1813 /* Return a numeric value for the swidth of the font whose XLFD font
1814 name fields are found in FONT. */
1817 xlfd_numeric_swidth (font
)
1818 struct font_name
*font
;
1820 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1821 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1825 /* Return a symbolic value for the swidth of FONT. */
1827 static INLINE Lisp_Object
1828 xlfd_symbolic_swidth (font
)
1829 struct font_name
*font
;
1831 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1832 font
, XLFD_SWIDTH
, Qnormal
);
1836 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1837 entries. Value is a pointer to the matching table entry or null if
1838 no element of TABLE contains SYMBOL. */
1840 static struct table_entry
*
1841 face_value (table
, dim
, symbol
)
1842 struct table_entry
*table
;
1848 xassert (SYMBOLP (symbol
));
1850 for (i
= 0; i
< dim
; ++i
)
1851 if (EQ (*table
[i
].symbol
, symbol
))
1854 return i
< dim
? table
+ i
: NULL
;
1858 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1859 entries. Value is -1 if SYMBOL is not found in TABLE. */
1862 face_numeric_value (table
, dim
, symbol
)
1863 struct table_entry
*table
;
1867 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1868 return p
? p
->numeric
: -1;
1872 /* Return a numeric value representing the weight specified by Lisp
1873 symbol WEIGHT. Value is one of the enumerators of enum
1877 face_numeric_weight (weight
)
1880 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1884 /* Return a numeric value representing the slant specified by Lisp
1885 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1888 face_numeric_slant (slant
)
1891 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1895 /* Return a numeric value representing the swidth specified by Lisp
1896 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1899 face_numeric_swidth (width
)
1902 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1906 #ifdef HAVE_X_WINDOWS
1908 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1912 struct font_name
*font
;
1914 /* Function split_font_name converts fields to lower-case, so there
1915 is no need to use tolower here. */
1916 return *font
->fields
[XLFD_SPACING
] != 'p';
1920 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1922 The actual height of the font when displayed on F depends on the
1923 resolution of both the font and frame. For example, a 10pt font
1924 designed for a 100dpi display will display larger than 10pt on a
1925 75dpi display. (It's not unusual to use fonts not designed for the
1926 display one is using. For example, some intlfonts are available in
1927 72dpi versions, only.)
1929 Value is the real point size of FONT on frame F, or 0 if it cannot
1933 xlfd_point_size (f
, font
)
1935 struct font_name
*font
;
1937 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1938 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1939 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1942 if (font_resy
== 0 || font_pt
== 0)
1945 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1951 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1952 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1953 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1954 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1955 zero if the font name doesn't have the format we expect. The
1956 expected format is a font name that starts with a `-' and has
1957 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1958 forms of font names where certain field contents are enclosed in
1959 square brackets. We don't support that, for now. */
1962 split_font_name (f
, font
, numeric_p
)
1964 struct font_name
*font
;
1970 if (*font
->name
== '-')
1972 char *p
= xstrlwr (font
->name
) + 1;
1974 while (i
< XLFD_LAST
)
1976 font
->fields
[i
] = p
;
1979 while (*p
&& *p
!= '-')
1989 success_p
= i
== XLFD_LAST
;
1991 /* If requested, and font name was in the expected format,
1992 compute numeric values for some fields. */
1993 if (numeric_p
&& success_p
)
1995 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
1996 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
1997 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
1998 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
1999 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2006 /* Build an XLFD font name from font name fields in FONT. Value is a
2007 pointer to the font name, which is allocated via xmalloc. */
2010 build_font_name (font
)
2011 struct font_name
*font
;
2015 char *font_name
= (char *) xmalloc (size
);
2016 int total_length
= 0;
2018 for (i
= 0; i
< XLFD_LAST
; ++i
)
2020 /* Add 1 because of the leading `-'. */
2021 int len
= strlen (font
->fields
[i
]) + 1;
2023 /* Reallocate font_name if necessary. Add 1 for the final
2025 if (total_length
+ len
+ 1 >= size
)
2027 int new_size
= max (2 * size
, size
+ len
+ 1);
2028 int sz
= new_size
* sizeof *font_name
;
2029 font_name
= (char *) xrealloc (font_name
, sz
);
2033 font_name
[total_length
] = '-';
2034 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2035 total_length
+= len
;
2038 font_name
[total_length
] = 0;
2043 /* Free an array FONTS of N font_name structures. This frees FONTS
2044 itself and all `name' fields in its elements. */
2047 free_font_names (fonts
, n
)
2048 struct font_name
*fonts
;
2052 xfree (fonts
[--n
].name
);
2057 /* Sort vector FONTS of font_name structures which contains NFONTS
2058 elements using qsort and comparison function CMPFN. F is the frame
2059 on which the fonts will be used. The global variable font_frame
2060 is temporarily set to F to make it available in CMPFN. */
2063 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2065 struct font_name
*fonts
;
2067 int (*cmpfn
) P_ ((const void *, const void *));
2070 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2075 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2076 display in x_display_list. FONTS is a pointer to a vector of
2077 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2078 alternative patterns from Valternate_fontname_alist if no fonts are
2079 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2082 For all fonts found, set FONTS[i].name to the name of the font,
2083 allocated via xmalloc, and split font names into fields. Ignore
2084 fonts that we can't parse. Value is the number of fonts found.
2086 This is similar to x_list_fonts. The differences are:
2088 1. It avoids consing.
2089 2. It never calls XLoadQueryFont. */
2092 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2096 struct font_name
*fonts
;
2097 int nfonts
, try_alternatives_p
;
2098 int scalable_fonts_p
;
2100 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2104 /* Get the list of fonts matching PATTERN from the X server. */
2106 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2111 /* Make a copy of the font names we got from X, and
2112 split them into fields. */
2113 for (i
= j
= 0; i
< n
; ++i
)
2115 /* Make a copy of the font name. */
2116 fonts
[j
].name
= xstrdup (names
[i
]);
2118 /* Ignore fonts having a name that we can't parse. */
2119 if (!split_font_name (f
, fonts
+ j
, 1))
2120 xfree (fonts
[j
].name
);
2121 else if (font_scalable_p (fonts
+ j
))
2124 if (!scalable_fonts_p
2125 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2126 xfree (fonts
[j
].name
);
2129 #else /* !SCALABLE_FONTS */
2130 /* Always ignore scalable fonts. */
2131 xfree (fonts
[j
].name
);
2132 #endif /* !SCALABLE_FONTS */
2140 /* Free font names. */
2142 XFreeFontNames (names
);
2147 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2148 if (n
== 0 && try_alternatives_p
)
2150 Lisp_Object list
= Valternate_fontname_alist
;
2152 while (CONSP (list
))
2154 Lisp_Object entry
= XCAR (list
);
2156 && STRINGP (XCAR (entry
))
2157 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2164 Lisp_Object patterns
= XCAR (list
);
2167 while (CONSP (patterns
)
2168 /* If list is screwed up, give up. */
2169 && (name
= XCAR (patterns
),
2171 /* Ignore patterns equal to PATTERN because we tried that
2172 already with no success. */
2173 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2174 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2178 patterns
= XCDR (patterns
);
2186 /* Determine the first font matching PATTERN on frame F. Return in
2187 *FONT the matching font name, split into fields. Value is non-zero
2188 if a match was found. */
2191 first_font_matching (f
, pattern
, font
)
2194 struct font_name
*font
;
2197 struct font_name
*fonts
;
2199 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2200 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2204 bcopy (&fonts
[0], font
, sizeof *font
);
2206 fonts
[0].name
= NULL
;
2207 free_font_names (fonts
, nfonts
);
2214 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2215 using comparison function CMPFN. Value is the number of fonts
2216 found. If value is non-zero, *FONTS is set to a vector of
2217 font_name structures allocated from the heap containing matching
2218 fonts. Each element of *FONTS contains a name member that is also
2219 allocated from the heap. Font names in these structures are split
2220 into fields. Use free_font_names to free such an array. */
2223 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2226 int (*cmpfn
) P_ ((const void *, const void *));
2227 struct font_name
**fonts
;
2231 /* Get the list of fonts matching pattern. 100 should suffice. */
2232 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2233 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2234 nfonts
= XFASTINT (Vfont_list_limit
);
2236 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2238 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2240 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2243 /* Sort the resulting array and return it in *FONTS. If no
2244 fonts were found, make sure to set *FONTS to null. */
2246 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2257 /* Compare two font_name structures *A and *B. Value is analogous to
2258 strcmp. Sort order is given by the global variable
2259 font_sort_order. Font names are sorted so that, everything else
2260 being equal, fonts with a resolution closer to that of the frame on
2261 which they are used are listed first. The global variable
2262 font_frame is the frame on which we operate. */
2265 cmp_font_names (a
, b
)
2268 struct font_name
*x
= (struct font_name
*) a
;
2269 struct font_name
*y
= (struct font_name
*) b
;
2272 /* All strings have been converted to lower-case by split_font_name,
2273 so we can use strcmp here. */
2274 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2279 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2281 int j
= font_sort_order
[i
];
2282 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2287 /* Everything else being equal, we prefer fonts with an
2288 y-resolution closer to that of the frame. */
2289 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2290 int x_resy
= x
->numeric
[XLFD_RESY
];
2291 int y_resy
= y
->numeric
[XLFD_RESY
];
2292 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2300 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2301 is non-null list fonts matching that pattern. Otherwise, if
2302 REGISTRY_AND_ENCODING is non-null return only fonts with that
2303 registry and encoding, otherwise return fonts of any registry and
2304 encoding. Set *FONTS to a vector of font_name structures allocated
2305 from the heap containing the fonts found. Value is the number of
2309 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2313 char *registry_and_encoding
;
2314 struct font_name
**fonts
;
2316 if (pattern
== NULL
)
2321 if (registry_and_encoding
== NULL
)
2322 registry_and_encoding
= "*";
2324 pattern
= (char *) alloca (strlen (family
)
2325 + strlen (registry_and_encoding
)
2327 if (index (family
, '-'))
2328 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2330 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2333 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2337 /* Remove elements from LIST whose cars are `equal'. Called from
2338 x-family-fonts and x-font-family-list to remove duplicate font
2342 remove_duplicates (list
)
2345 Lisp_Object tail
= list
;
2347 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2349 Lisp_Object next
= XCDR (tail
);
2350 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2351 XCDR (tail
) = XCDR (next
);
2358 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2359 "Return a list of available fonts of family FAMILY on FRAME.\n\
2360 If FAMILY is omitted or nil, list all families.\n\
2361 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2363 If FRAME is omitted or nil, use the selected frame.\n\
2364 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2365 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2366 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2367 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2368 width, weight and slant of the font. These symbols are the same as for\n\
2369 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2370 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2371 giving the registry and encoding of the font.\n\
2372 The result list is sorted according to the current setting of\n\
2373 the face font sort order.")
2375 Lisp_Object family
, frame
;
2377 struct frame
*f
= check_x_frame (frame
);
2378 struct font_name
*fonts
;
2381 struct gcpro gcpro1
;
2382 char *family_pattern
;
2385 family_pattern
= "*";
2388 CHECK_STRING (family
, 1);
2389 family_pattern
= LSTRDUPA (family
);
2394 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2395 for (i
= nfonts
- 1; i
>= 0; --i
)
2397 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2400 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2402 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2403 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2404 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2405 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2406 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2407 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2408 tem
= build_font_name (fonts
+ i
);
2409 ASET (v
, 6, build_string (tem
));
2410 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2411 fonts
[i
].fields
[XLFD_ENCODING
]);
2412 ASET (v
, 7, build_string (tem
));
2415 result
= Fcons (v
, result
);
2420 remove_duplicates (result
);
2421 free_font_names (fonts
, nfonts
);
2427 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2429 "Return a list of available font families on FRAME.\n\
2430 If FRAME is omitted or nil, use the selected frame.\n\
2431 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2432 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2437 struct frame
*f
= check_x_frame (frame
);
2439 struct font_name
*fonts
;
2441 struct gcpro gcpro1
;
2442 int count
= specpdl_ptr
- specpdl
;
2445 /* Let's consider all fonts. Increase the limit for matching
2446 fonts until we have them all. */
2449 specbind (intern ("font-list-limit"), make_number (limit
));
2450 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2452 if (nfonts
== limit
)
2454 free_font_names (fonts
, nfonts
);
2463 for (i
= nfonts
- 1; i
>= 0; --i
)
2464 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2465 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2468 remove_duplicates (result
);
2469 free_font_names (fonts
, nfonts
);
2471 return unbind_to (count
, result
);
2475 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2476 "Return a list of the names of available fonts matching PATTERN.\n\
2477 If optional arguments FACE and FRAME are specified, return only fonts\n\
2478 the same size as FACE on FRAME.\n\
2479 PATTERN is a string, perhaps with wildcard characters;\n\
2480 the * character matches any substring, and\n\
2481 the ? character matches any single character.\n\
2482 PATTERN is case-insensitive.\n\
2483 FACE is a face name--a symbol.\n\
2485 The return value is a list of strings, suitable as arguments to\n\
2488 Fonts Emacs can't use may or may not be excluded\n\
2489 even if they match PATTERN and FACE.\n\
2490 The optional fourth argument MAXIMUM sets a limit on how many\n\
2491 fonts to match. The first MAXIMUM fonts are reported.\n\
2492 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2493 occupied by a character of a font. In that case, return only fonts\n\
2494 the WIDTH times as wide as FACE on FRAME.")
2495 (pattern
, face
, frame
, maximum
, width
)
2496 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2503 CHECK_STRING (pattern
, 0);
2509 CHECK_NATNUM (maximum
, 0);
2510 maxnames
= XINT (maximum
);
2514 CHECK_NUMBER (width
, 4);
2516 /* We can't simply call check_x_frame because this function may be
2517 called before any frame is created. */
2518 f
= frame_or_selected_frame (frame
, 2);
2521 /* Perhaps we have not yet created any frame. */
2526 /* Determine the width standard for comparison with the fonts we find. */
2532 /* This is of limited utility since it works with character
2533 widths. Keep it for compatibility. --gerd. */
2534 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2535 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2538 size
= face
->font
->max_bounds
.width
;
2540 size
= FRAME_FONT (f
)->max_bounds
.width
;
2543 size
*= XINT (width
);
2547 Lisp_Object args
[2];
2549 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2551 /* We don't have to check fontsets. */
2553 args
[1] = list_fontsets (f
, pattern
, size
);
2554 return Fnconc (2, args
);
2558 #endif /* HAVE_X_WINDOWS */
2562 /***********************************************************************
2564 ***********************************************************************/
2566 /* Access face attributes of face FACE, a Lisp vector. */
2568 #define LFACE_FAMILY(LFACE) \
2569 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2570 #define LFACE_HEIGHT(LFACE) \
2571 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2572 #define LFACE_WEIGHT(LFACE) \
2573 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2574 #define LFACE_SLANT(LFACE) \
2575 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2576 #define LFACE_UNDERLINE(LFACE) \
2577 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2578 #define LFACE_INVERSE(LFACE) \
2579 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2580 #define LFACE_FOREGROUND(LFACE) \
2581 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2582 #define LFACE_BACKGROUND(LFACE) \
2583 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2584 #define LFACE_STIPPLE(LFACE) \
2585 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2586 #define LFACE_SWIDTH(LFACE) \
2587 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2588 #define LFACE_OVERLINE(LFACE) \
2589 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2590 #define LFACE_STRIKE_THROUGH(LFACE) \
2591 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2592 #define LFACE_BOX(LFACE) \
2593 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2595 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2596 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2598 #define LFACEP(LFACE) \
2600 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2601 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2606 /* Check consistency of Lisp face attribute vector ATTRS. */
2609 check_lface_attrs (attrs
)
2612 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2613 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2614 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2615 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2616 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2617 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2618 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2619 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2620 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2621 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2622 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2623 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2624 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2625 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2626 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2627 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2628 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2629 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2630 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2631 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2632 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2633 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2634 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2635 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2636 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2637 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2638 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2639 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2640 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2641 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2642 #ifdef HAVE_WINDOW_SYSTEM
2643 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2644 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2645 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2650 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2658 xassert (LFACEP (lface
));
2659 check_lface_attrs (XVECTOR (lface
)->contents
);
2663 #else /* GLYPH_DEBUG == 0 */
2665 #define check_lface_attrs(attrs) (void) 0
2666 #define check_lface(lface) (void) 0
2668 #endif /* GLYPH_DEBUG == 0 */
2671 /* Resolve face name FACE_NAME. If FACE_NAME Is a string, intern it
2672 to make it a symvol. If FACE_NAME is an alias for another face,
2673 return that face's name. */
2676 resolve_face_name (face_name
)
2677 Lisp_Object face_name
;
2679 Lisp_Object aliased
;
2681 if (STRINGP (face_name
))
2682 face_name
= intern (XSTRING (face_name
)->data
);
2686 aliased
= Fget (face_name
, Qface_alias
);
2690 face_name
= aliased
;
2697 /* Return the face definition of FACE_NAME on frame F. F null means
2698 return the global definition. FACE_NAME may be a string or a
2699 symbol (apparently Emacs 20.2 allows strings as face names in face
2700 text properties; ediff uses that). If FACE_NAME is an alias for
2701 another face, return that face's definition. If SIGNAL_P is
2702 non-zero, signal an error if FACE_NAME is not a valid face name.
2703 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2706 static INLINE Lisp_Object
2707 lface_from_face_name (f
, face_name
, signal_p
)
2709 Lisp_Object face_name
;
2714 face_name
= resolve_face_name (face_name
);
2717 lface
= assq_no_quit (face_name
, f
->face_alist
);
2719 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2722 lface
= XCDR (lface
);
2724 signal_error ("Invalid face", face_name
);
2726 check_lface (lface
);
2731 /* Get face attributes of face FACE_NAME from frame-local faces on
2732 frame F. Store the resulting attributes in ATTRS which must point
2733 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2734 is non-zero, signal an error if FACE_NAME does not name a face.
2735 Otherwise, value is zero if FACE_NAME is not a face. */
2738 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2740 Lisp_Object face_name
;
2747 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2750 bcopy (XVECTOR (lface
)->contents
, attrs
,
2751 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2761 /* Non-zero if all attributes in face attribute vector ATTRS are
2762 specified, i.e. are non-nil. */
2765 lface_fully_specified_p (attrs
)
2770 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2771 if (UNSPECIFIEDP (attrs
[i
]))
2774 return i
== LFACE_VECTOR_SIZE
;
2778 #ifdef HAVE_X_WINDOWS
2780 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2781 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2782 LFACE. MAY_FAIL_P non-zero means return 0 if FONT_NAME isn't a
2783 valid font name; otherwise this function tries to use a reasonable
2786 Ignore fields of FONT_NAME containing wildcards. Value is zero if
2787 not successful because FONT_NAME was not in a valid format and
2788 MAY_FAIL_P was non-zero. A valid format is one that is suitable
2789 for split_font_name, see the comment there. */
2792 set_lface_from_font_name (f
, lface
, font_name
, force_p
, may_fail_p
)
2796 int force_p
, may_fail_p
;
2798 struct font_name font
;
2801 int free_font_name_p
= 0;
2802 int have_font_p
= 0;
2804 /* If FONT_NAME contains wildcards, use the first matching font. */
2805 if (index (font_name
, '*') || index (font_name
, '?'))
2807 if (first_font_matching (f
, font_name
, &font
))
2808 free_font_name_p
= have_font_p
= 1;
2812 font
.name
= STRDUPA (font_name
);
2813 if (split_font_name (f
, &font
, 1))
2817 /* The font name may be something like `6x13'. Make
2818 sure we use the full name. */
2819 struct font_info
*font_info
;
2822 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2823 CHARSET_ASCII
, font_name
, -1);
2826 font
.name
= STRDUPA (font_info
->full_name
);
2827 split_font_name (f
, &font
, 1);
2834 /* If FONT_NAME is completely bogus try to use something reasonable
2835 if this function must succeed. Otherwise, give up. */
2840 else if (first_font_matching (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
2842 || first_font_matching (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2844 || first_font_matching (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2846 || first_font_matching (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
2848 || first_font_matching (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
2850 || first_font_matching (f
, "fixed", &font
))
2851 free_font_name_p
= 1;
2857 /* Set attributes only if unspecified, otherwise face defaults for
2858 new frames would never take effect. */
2860 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2862 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2863 + strlen (font
.fields
[XLFD_FOUNDRY
])
2865 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2866 font
.fields
[XLFD_FAMILY
]);
2867 LFACE_FAMILY (lface
) = build_string (buffer
);
2870 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2872 pt
= xlfd_point_size (f
, &font
);
2874 LFACE_HEIGHT (lface
) = make_number (pt
);
2877 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2878 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2880 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2881 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2883 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2884 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2886 if (free_font_name_p
)
2892 #endif /* HAVE_X_WINDOWS */
2895 /* Merge two Lisp face attribute vectors FROM and TO and store the
2896 resulting attributes in TO. Every non-nil attribute of FROM
2897 overrides the corresponding attribute of TO. */
2900 merge_face_vectors (from
, to
)
2901 Lisp_Object
*from
, *to
;
2904 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2905 if (!UNSPECIFIEDP (from
[i
]))
2910 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2911 is a face property, determine the resulting face attributes on
2912 frame F, and store them in TO. PROP may be a single face
2913 specification or a list of such specifications. Each face
2914 specification can be
2916 1. A symbol or string naming a Lisp face.
2918 2. A property list of the form (KEYWORD VALUE ...) where each
2919 KEYWORD is a face attribute name, and value is an appropriate value
2922 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2923 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2924 for compatibility with 20.2.
2926 Face specifications earlier in lists take precedence over later
2930 merge_face_vector_with_property (f
, to
, prop
)
2937 Lisp_Object first
= XCAR (prop
);
2939 if (EQ (first
, Qforeground_color
)
2940 || EQ (first
, Qbackground_color
))
2942 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2943 . COLOR). COLOR must be a string. */
2944 Lisp_Object color_name
= XCDR (prop
);
2945 Lisp_Object color
= first
;
2947 if (STRINGP (color_name
))
2949 if (EQ (color
, Qforeground_color
))
2950 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2952 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2955 add_to_log ("Invalid face color", color_name
, Qnil
);
2957 else if (SYMBOLP (first
)
2958 && *XSYMBOL (first
)->name
->data
== ':')
2960 /* Assume this is the property list form. */
2961 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2963 Lisp_Object keyword
= XCAR (prop
);
2964 Lisp_Object value
= XCAR (XCDR (prop
));
2966 if (EQ (keyword
, QCfamily
))
2968 if (STRINGP (value
))
2969 to
[LFACE_FAMILY_INDEX
] = value
;
2971 add_to_log ("Illegal face font family", value
, Qnil
);
2973 else if (EQ (keyword
, QCheight
))
2975 if (INTEGERP (value
))
2976 to
[LFACE_HEIGHT_INDEX
] = value
;
2978 add_to_log ("Illegal face font height", value
, Qnil
);
2980 else if (EQ (keyword
, QCweight
))
2983 && face_numeric_weight (value
) >= 0)
2984 to
[LFACE_WEIGHT_INDEX
] = value
;
2986 add_to_log ("Illegal face weight", value
, Qnil
);
2988 else if (EQ (keyword
, QCslant
))
2991 && face_numeric_slant (value
) >= 0)
2992 to
[LFACE_SLANT_INDEX
] = value
;
2994 add_to_log ("Illegal face slant", value
, Qnil
);
2996 else if (EQ (keyword
, QCunderline
))
3001 to
[LFACE_UNDERLINE_INDEX
] = value
;
3003 add_to_log ("Illegal face underline", value
, Qnil
);
3005 else if (EQ (keyword
, QCoverline
))
3010 to
[LFACE_OVERLINE_INDEX
] = value
;
3012 add_to_log ("Illegal face overline", value
, Qnil
);
3014 else if (EQ (keyword
, QCstrike_through
))
3019 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3021 add_to_log ("Illegal face strike-through", value
, Qnil
);
3023 else if (EQ (keyword
, QCbox
))
3026 value
= make_number (1);
3027 if (INTEGERP (value
)
3031 to
[LFACE_BOX_INDEX
] = value
;
3033 add_to_log ("Illegal face box", value
, Qnil
);
3035 else if (EQ (keyword
, QCinverse_video
)
3036 || EQ (keyword
, QCreverse_video
))
3038 if (EQ (value
, Qt
) || NILP (value
))
3039 to
[LFACE_INVERSE_INDEX
] = value
;
3041 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3043 else if (EQ (keyword
, QCforeground
))
3045 if (STRINGP (value
))
3046 to
[LFACE_FOREGROUND_INDEX
] = value
;
3048 add_to_log ("Illegal face foreground", value
, Qnil
);
3050 else if (EQ (keyword
, QCbackground
))
3052 if (STRINGP (value
))
3053 to
[LFACE_BACKGROUND_INDEX
] = value
;
3055 add_to_log ("Illegal face background", value
, Qnil
);
3057 else if (EQ (keyword
, QCstipple
))
3059 #ifdef HAVE_X_WINDOWS
3060 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3061 if (!NILP (pixmap_p
))
3062 to
[LFACE_STIPPLE_INDEX
] = value
;
3064 add_to_log ("Illegal face stipple", value
, Qnil
);
3067 else if (EQ (keyword
, QCwidth
))
3070 && face_numeric_swidth (value
) >= 0)
3071 to
[LFACE_SWIDTH_INDEX
] = value
;
3073 add_to_log ("Illegal face width", value
, Qnil
);
3076 add_to_log ("Invalid attribute %s in face property",
3079 prop
= XCDR (XCDR (prop
));
3084 /* This is a list of face specs. Specifications at the
3085 beginning of the list take precedence over later
3086 specifications, so we have to merge starting with the
3087 last specification. */
3088 Lisp_Object next
= XCDR (prop
);
3090 merge_face_vector_with_property (f
, to
, next
);
3091 merge_face_vector_with_property (f
, to
, first
);
3096 /* PROP ought to be a face name. */
3097 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3099 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3101 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3106 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3107 Sinternal_make_lisp_face
, 1, 2, 0,
3108 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3109 If FACE was not known as a face before, create a new one.\n\
3110 If optional argument FRAME is specified, make a frame-local face\n\
3111 for that frame. Otherwise operate on the global face definition.\n\
3112 Value is a vector of face attributes.")
3114 Lisp_Object face
, frame
;
3116 Lisp_Object global_lface
, lface
;
3120 CHECK_SYMBOL (face
, 0);
3121 global_lface
= lface_from_face_name (NULL
, face
, 0);
3125 CHECK_LIVE_FRAME (frame
, 1);
3127 lface
= lface_from_face_name (f
, face
, 0);
3130 f
= NULL
, lface
= Qnil
;
3132 /* Add a global definition if there is none. */
3133 if (NILP (global_lface
))
3135 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3137 XVECTOR (global_lface
)->contents
[0] = Qface
;
3138 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3139 Vface_new_frame_defaults
);
3141 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3142 face id to Lisp face is given by the vector lface_id_to_name.
3143 The mapping from Lisp face to Lisp face id is given by the
3144 property `face' of the Lisp face name. */
3145 if (next_lface_id
== lface_id_to_name_size
)
3147 int new_size
= max (50, 2 * lface_id_to_name_size
);
3148 int sz
= new_size
* sizeof *lface_id_to_name
;
3149 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3150 lface_id_to_name_size
= new_size
;
3153 lface_id_to_name
[next_lface_id
] = face
;
3154 Fput (face
, Qface
, make_number (next_lface_id
));
3158 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3159 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3161 /* Add a frame-local definition. */
3166 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3168 XVECTOR (lface
)->contents
[0] = Qface
;
3169 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3172 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3173 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3176 lface
= global_lface
;
3178 xassert (LFACEP (lface
));
3179 check_lface (lface
);
3184 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3185 Sinternal_lisp_face_p
, 1, 2, 0,
3186 "Return non-nil if FACE names a face.\n\
3187 If optional second parameter FRAME is non-nil, check for the\n\
3188 existence of a frame-local face with name FACE on that frame.\n\
3189 Otherwise check for the existence of a global face.")
3191 Lisp_Object face
, frame
;
3197 CHECK_LIVE_FRAME (frame
, 1);
3198 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3201 lface
= lface_from_face_name (NULL
, face
, 0);
3207 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3208 Sinternal_copy_lisp_face
, 4, 4, 0,
3209 "Copy face FROM to TO.\n\
3210 If FRAME it t, copy the global face definition of FROM to the\n\
3211 global face definition of TO. Otherwise, copy the frame-local\n\
3212 definition of FROM on FRAME to the frame-local definition of TO\n\
3213 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3216 (from
, to
, frame
, new_frame
)
3217 Lisp_Object from
, to
, frame
, new_frame
;
3219 Lisp_Object lface
, copy
;
3221 CHECK_SYMBOL (from
, 0);
3222 CHECK_SYMBOL (to
, 1);
3223 if (NILP (new_frame
))
3228 /* Copy global definition of FROM. We don't make copies of
3229 strings etc. because 20.2 didn't do it either. */
3230 lface
= lface_from_face_name (NULL
, from
, 1);
3231 copy
= Finternal_make_lisp_face (to
, Qnil
);
3235 /* Copy frame-local definition of FROM. */
3236 CHECK_LIVE_FRAME (frame
, 2);
3237 CHECK_LIVE_FRAME (new_frame
, 3);
3238 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3239 copy
= Finternal_make_lisp_face (to
, new_frame
);
3242 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3243 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3249 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3250 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3251 "Set attribute ATTR of FACE to VALUE.\n\
3252 If optional argument FRAME is given, set the face attribute of face FACE\n\
3253 on that frame. If FRAME is t, set the attribute of the default for face\n\
3254 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3256 (face
, attr
, value
, frame
)
3257 Lisp_Object face
, attr
, value
, frame
;
3260 Lisp_Object old_value
= Qnil
;
3261 int font_related_attr_p
= 0;
3263 CHECK_SYMBOL (face
, 0);
3264 CHECK_SYMBOL (attr
, 1);
3266 face
= resolve_face_name (face
);
3268 /* Set lface to the Lisp attribute vector of FACE. */
3270 lface
= lface_from_face_name (NULL
, face
, 1);
3274 frame
= selected_frame
;
3276 CHECK_LIVE_FRAME (frame
, 3);
3277 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3279 /* If a frame-local face doesn't exist yet, create one. */
3281 lface
= Finternal_make_lisp_face (face
, frame
);
3284 if (EQ (attr
, QCfamily
))
3286 if (!UNSPECIFIEDP (value
))
3288 CHECK_STRING (value
, 3);
3289 if (XSTRING (value
)->size
== 0)
3290 signal_error ("Invalid face family", value
);
3292 old_value
= LFACE_FAMILY (lface
);
3293 LFACE_FAMILY (lface
) = value
;
3294 font_related_attr_p
= 1;
3296 else if (EQ (attr
, QCheight
))
3298 if (!UNSPECIFIEDP (value
))
3300 CHECK_NUMBER (value
, 3);
3301 if (XINT (value
) <= 0)
3302 signal_error ("Invalid face height", value
);
3304 old_value
= LFACE_HEIGHT (lface
);
3305 LFACE_HEIGHT (lface
) = value
;
3306 font_related_attr_p
= 1;
3308 else if (EQ (attr
, QCweight
))
3310 if (!UNSPECIFIEDP (value
))
3312 CHECK_SYMBOL (value
, 3);
3313 if (face_numeric_weight (value
) < 0)
3314 signal_error ("Invalid face weight", value
);
3316 old_value
= LFACE_WEIGHT (lface
);
3317 LFACE_WEIGHT (lface
) = value
;
3318 font_related_attr_p
= 1;
3320 else if (EQ (attr
, QCslant
))
3322 if (!UNSPECIFIEDP (value
))
3324 CHECK_SYMBOL (value
, 3);
3325 if (face_numeric_slant (value
) < 0)
3326 signal_error ("Invalid face slant", value
);
3328 old_value
= LFACE_SLANT (lface
);
3329 LFACE_SLANT (lface
) = value
;
3330 font_related_attr_p
= 1;
3332 else if (EQ (attr
, QCunderline
))
3334 if (!UNSPECIFIEDP (value
))
3335 if ((SYMBOLP (value
)
3337 && !EQ (value
, Qnil
))
3338 /* Underline color. */
3340 && XSTRING (value
)->size
== 0))
3341 signal_error ("Invalid face underline", value
);
3343 old_value
= LFACE_UNDERLINE (lface
);
3344 LFACE_UNDERLINE (lface
) = value
;
3346 else if (EQ (attr
, QCoverline
))
3348 if (!UNSPECIFIEDP (value
))
3349 if ((SYMBOLP (value
)
3351 && !EQ (value
, Qnil
))
3352 /* Overline color. */
3354 && XSTRING (value
)->size
== 0))
3355 signal_error ("Invalid face overline", value
);
3357 old_value
= LFACE_OVERLINE (lface
);
3358 LFACE_OVERLINE (lface
) = value
;
3360 else if (EQ (attr
, QCstrike_through
))
3362 if (!UNSPECIFIEDP (value
))
3363 if ((SYMBOLP (value
)
3365 && !EQ (value
, Qnil
))
3366 /* Strike-through color. */
3368 && XSTRING (value
)->size
== 0))
3369 signal_error ("Invalid face strike-through", value
);
3371 old_value
= LFACE_STRIKE_THROUGH (lface
);
3372 LFACE_STRIKE_THROUGH (lface
) = value
;
3374 else if (EQ (attr
, QCbox
))
3378 /* Allow t meaning a simple box of width 1 in foreground color
3381 value
= make_number (1);
3383 if (UNSPECIFIEDP (value
))
3385 else if (NILP (value
))
3387 else if (INTEGERP (value
))
3388 valid_p
= XINT (value
) > 0;
3389 else if (STRINGP (value
))
3390 valid_p
= XSTRING (value
)->size
> 0;
3391 else if (CONSP (value
))
3407 if (EQ (k
, QCline_width
))
3409 if (!INTEGERP (v
) || XINT (v
) <= 0)
3412 else if (EQ (k
, QCcolor
))
3414 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3417 else if (EQ (k
, QCstyle
))
3419 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3426 valid_p
= NILP (tem
);
3432 signal_error ("Invalid face box", value
);
3434 old_value
= LFACE_BOX (lface
);
3435 LFACE_BOX (lface
) = value
;
3437 else if (EQ (attr
, QCinverse_video
)
3438 || EQ (attr
, QCreverse_video
))
3440 if (!UNSPECIFIEDP (value
))
3442 CHECK_SYMBOL (value
, 3);
3443 if (!EQ (value
, Qt
) && !NILP (value
))
3444 signal_error ("Invalid inverse-video face attribute value", value
);
3446 old_value
= LFACE_INVERSE (lface
);
3447 LFACE_INVERSE (lface
) = value
;
3449 else if (EQ (attr
, QCforeground
))
3451 if (!UNSPECIFIEDP (value
))
3453 /* Don't check for valid color names here because it depends
3454 on the frame (display) whether the color will be valid
3455 when the face is realized. */
3456 CHECK_STRING (value
, 3);
3457 if (XSTRING (value
)->size
== 0)
3458 signal_error ("Empty foreground color value", value
);
3460 old_value
= LFACE_FOREGROUND (lface
);
3461 LFACE_FOREGROUND (lface
) = value
;
3463 else if (EQ (attr
, QCbackground
))
3465 if (!UNSPECIFIEDP (value
))
3467 /* Don't check for valid color names here because it depends
3468 on the frame (display) whether the color will be valid
3469 when the face is realized. */
3470 CHECK_STRING (value
, 3);
3471 if (XSTRING (value
)->size
== 0)
3472 signal_error ("Empty background color value", value
);
3474 old_value
= LFACE_BACKGROUND (lface
);
3475 LFACE_BACKGROUND (lface
) = value
;
3477 else if (EQ (attr
, QCstipple
))
3479 #ifdef HAVE_X_WINDOWS
3480 if (!UNSPECIFIEDP (value
)
3482 && NILP (Fbitmap_spec_p (value
)))
3483 signal_error ("Invalid stipple attribute", value
);
3484 old_value
= LFACE_STIPPLE (lface
);
3485 LFACE_STIPPLE (lface
) = value
;
3486 #endif /* HAVE_X_WINDOWS */
3488 else if (EQ (attr
, QCwidth
))
3490 if (!UNSPECIFIEDP (value
))
3492 CHECK_SYMBOL (value
, 3);
3493 if (face_numeric_swidth (value
) < 0)
3494 signal_error ("Invalid face width", value
);
3496 old_value
= LFACE_SWIDTH (lface
);
3497 LFACE_SWIDTH (lface
) = value
;
3498 font_related_attr_p
= 1;
3500 else if (EQ (attr
, QCfont
))
3502 #ifdef HAVE_X_WINDOWS
3503 /* Set font-related attributes of the Lisp face from an
3507 CHECK_STRING (value
, 3);
3509 f
= SELECTED_FRAME ();
3511 f
= check_x_frame (frame
);
3513 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1, 1))
3514 signal_error ("Invalid font name", value
);
3516 font_related_attr_p
= 1;
3517 #endif /* HAVE_X_WINDOWS */
3519 else if (EQ (attr
, QCbold
))
3521 old_value
= LFACE_WEIGHT (lface
);
3522 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3523 font_related_attr_p
= 1;
3525 else if (EQ (attr
, QCitalic
))
3527 old_value
= LFACE_SLANT (lface
);
3528 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3529 font_related_attr_p
= 1;
3532 signal_error ("Invalid face attribute name", attr
);
3534 /* Changing a named face means that all realized faces depending on
3535 that face are invalid. Since we cannot tell which realized faces
3536 depend on the face, make sure they are all removed. This is done
3537 by incrementing face_change_count. The next call to
3538 init_iterator will then free realized faces. */
3540 && (EQ (attr
, QCfont
)
3541 || NILP (Fequal (old_value
, value
))))
3543 ++face_change_count
;
3544 ++windows_or_buffers_changed
;
3547 #ifdef HAVE_X_WINDOWS
3550 && !UNSPECIFIEDP (value
)
3551 && NILP (Fequal (old_value
, value
)))
3557 if (EQ (face
, Qdefault
))
3559 /* Changed font-related attributes of the `default' face are
3560 reflected in changed `font' frame parameters. */
3561 if (font_related_attr_p
3562 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3563 set_font_frame_param (frame
, lface
);
3564 else if (EQ (attr
, QCforeground
))
3565 param
= Qforeground_color
;
3566 else if (EQ (attr
, QCbackground
))
3567 param
= Qbackground_color
;
3569 else if (EQ (face
, Qscroll_bar
))
3571 /* Changing the colors of `scroll-bar' sets frame parameters
3572 `scroll-bar-foreground' and `scroll-bar-background'. */
3573 if (EQ (attr
, QCforeground
))
3574 param
= Qscroll_bar_foreground
;
3575 else if (EQ (attr
, QCbackground
))
3576 param
= Qscroll_bar_background
;
3578 else if (EQ (face
, Qborder
))
3580 /* Changing background color of `border' sets frame parameter
3582 if (EQ (attr
, QCbackground
))
3583 param
= Qborder_color
;
3585 else if (EQ (face
, Qcursor
))
3587 /* Changing background color of `cursor' sets frame parameter
3589 if (EQ (attr
, QCbackground
))
3590 param
= Qcursor_color
;
3592 else if (EQ (face
, Qmouse
))
3594 /* Changing background color of `mouse' sets frame parameter
3596 if (EQ (attr
, QCbackground
))
3597 param
= Qmouse_color
;
3600 if (SYMBOLP (param
))
3601 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3604 #endif /* HAVE_X_WINDOWS */
3610 #ifdef HAVE_X_WINDOWS
3612 /* Set the `font' frame parameter of FRAME according to `default' face
3613 attributes LFACE. */
3616 set_font_frame_param (frame
, lface
)
3617 Lisp_Object frame
, lface
;
3619 struct frame
*f
= XFRAME (frame
);
3620 Lisp_Object frame_font
;
3624 /* Get FRAME's font parameter. */
3625 frame_font
= Fassq (Qfont
, f
->param_alist
);
3626 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3627 frame_font
= XCDR (frame_font
);
3629 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3632 /* Frame parameter is a fontset name. Modify the fontset so
3633 that all its fonts reflect face attributes LFACE. */
3635 struct fontset_info
*fontset_info
;
3637 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3639 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3640 if (fontset_info
->fontname
[charset
])
3642 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3644 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3645 build_string (font
), frame
);
3651 /* Frame parameter is an X font name. I believe this can
3652 only happen in unibyte mode. */
3653 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3654 -1, Vface_default_registry
);
3657 store_frame_param (f
, Qfont
, build_string (font
));
3664 /* Update the corresponding face when frame parameter PARAM on frame F
3665 has been assigned the value NEW_VALUE. */
3668 update_face_from_frame_parameter (f
, param
, new_value
)
3670 Lisp_Object param
, new_value
;
3674 /* If there are no faces yet, give up. This is the case when called
3675 from Fx_create_frame, and we do the necessary things later in
3676 face-set-after-frame-defaults. */
3677 if (NILP (f
->face_alist
))
3680 if (EQ (param
, Qforeground_color
))
3682 lface
= lface_from_face_name (f
, Qdefault
, 1);
3683 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3684 ? new_value
: Qunspecified
);
3685 realize_basic_faces (f
);
3687 else if (EQ (param
, Qbackground_color
))
3691 /* Changing the background color might change the background
3692 mode, so that we have to load new defface specs. Call
3693 frame-update-face-colors to do that. */
3694 XSETFRAME (frame
, f
);
3695 call1 (Qframe_update_face_colors
, frame
);
3697 lface
= lface_from_face_name (f
, Qdefault
, 1);
3698 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3699 ? new_value
: Qunspecified
);
3700 realize_basic_faces (f
);
3702 if (EQ (param
, Qborder_color
))
3704 lface
= lface_from_face_name (f
, Qborder
, 1);
3705 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3706 ? new_value
: Qunspecified
);
3708 else if (EQ (param
, Qcursor_color
))
3710 lface
= lface_from_face_name (f
, Qcursor
, 1);
3711 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3712 ? new_value
: Qunspecified
);
3714 else if (EQ (param
, Qmouse_color
))
3716 lface
= lface_from_face_name (f
, Qmouse
, 1);
3717 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3718 ? new_value
: Qunspecified
);
3723 /* Get the value of X resource RESOURCE, class CLASS for the display
3724 of frame FRAME. This is here because ordinary `x-get-resource'
3725 doesn't take a frame argument. */
3727 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3728 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3729 (resource
, class, frame
)
3730 Lisp_Object resource
, class, frame
;
3733 CHECK_STRING (resource
, 0);
3734 CHECK_STRING (class, 1);
3735 CHECK_LIVE_FRAME (frame
, 2);
3737 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3738 resource
, class, Qnil
, Qnil
);
3744 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3745 If VALUE is "on" or "true", return t. If VALUE is "off" or
3746 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3747 error; if SIGNAL_P is zero, return 0. */
3750 face_boolean_x_resource_value (value
, signal_p
)
3754 Lisp_Object result
= make_number (0);
3756 xassert (STRINGP (value
));
3758 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3759 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3761 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3762 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3764 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3765 result
= Qunspecified
;
3767 signal_error ("Invalid face attribute value from X resource", value
);
3773 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3774 Finternal_set_lisp_face_attribute_from_resource
,
3775 Sinternal_set_lisp_face_attribute_from_resource
,
3777 (face
, attr
, value
, frame
)
3778 Lisp_Object face
, attr
, value
, frame
;
3780 CHECK_SYMBOL (face
, 0);
3781 CHECK_SYMBOL (attr
, 1);
3782 CHECK_STRING (value
, 2);
3784 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3785 value
= Qunspecified
;
3786 else if (EQ (attr
, QCheight
))
3788 value
= Fstring_to_number (value
, make_number (10));
3789 if (XINT (value
) <= 0)
3790 signal_error ("Invalid face height from X resource", value
);
3792 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3793 value
= face_boolean_x_resource_value (value
, 1);
3794 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3795 value
= intern (XSTRING (value
)->data
);
3796 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3797 value
= face_boolean_x_resource_value (value
, 1);
3798 else if (EQ (attr
, QCunderline
)
3799 || EQ (attr
, QCoverline
)
3800 || EQ (attr
, QCstrike_through
)
3801 || EQ (attr
, QCbox
))
3803 Lisp_Object boolean_value
;
3805 /* If the result of face_boolean_x_resource_value is t or nil,
3806 VALUE does NOT specify a color. */
3807 boolean_value
= face_boolean_x_resource_value (value
, 0);
3808 if (SYMBOLP (boolean_value
))
3809 value
= boolean_value
;
3812 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3817 /***********************************************************************
3819 ***********************************************************************/
3821 #ifdef USE_X_TOOLKIT
3823 /* Structure used to pass X resources to functions called via
3824 XtApplyToWidgets. */
3835 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3836 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3839 /* Set widget W's X resources from P which points to an x_resources
3840 structure. If W is a cascade button, apply resources to W's
3844 xm_apply_resources (w
, p
)
3849 struct x_resources
*res
= (struct x_resources
*) p
;
3851 XtSetValues (w
, res
->av
, res
->ac
);
3852 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3855 XtSetValues (submenu
, res
->av
, res
->ac
);
3856 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3861 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3862 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3865 1. Setting the XmNfontList resource leads to an infinite loop
3866 somewhere in LessTif. */
3869 xm_set_menu_resources_from_menu_face (f
, widget
)
3879 lface
= lface_from_face_name (f
, Qmenu
, 1);
3880 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3882 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3884 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
3888 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3890 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
3894 /* If any font-related attribute of `menu' is set, set the font. */
3896 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3897 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3898 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3899 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3900 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3902 #if 0 /* Setting the font leads to an infinite loop somewhere
3903 in LessTif during geometry computation. */
3905 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
3906 fl
= XmFontListAppendEntry (NULL
, fe
);
3907 XtSetArg (av
[ac
], XmNfontList
, fl
);
3912 xassert (ac
<= sizeof av
/ sizeof *av
);
3916 struct x_resources res
;
3918 XtSetValues (widget
, av
, ac
);
3919 res
.av
= av
, res
.ac
= ac
;
3920 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
3922 XmFontListFree (fl
);
3927 #endif /* USE_MOTIF */
3931 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
3932 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3935 /* Set widget W's resources from P which points to an x_resources
3939 xl_apply_resources (widget
, p
)
3943 struct x_resources
*res
= (struct x_resources
*) p
;
3944 XtSetValues (widget
, res
->av
, res
->ac
);
3948 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
3949 This is the Lucid version. */
3952 xl_set_menu_resources_from_menu_face (f
, widget
)
3961 lface
= lface_from_face_name (f
, Qmenu
, 1);
3962 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3964 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3966 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
3970 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3972 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
3977 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3978 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3979 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3980 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3981 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3983 XtSetArg (av
[ac
], XtNfont
, face
->font
);
3989 struct x_resources res
;
3991 XtSetValues (widget
, av
, ac
);
3993 /* We must do children here in case we're handling a pop-up menu
3994 in which case WIDGET is a popup shell. XtApplyToWidgets
3995 is a function from lwlib. */
3996 res
.av
= av
, res
.ac
= ac
;
3997 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4001 #endif /* USE_LUCID */
4004 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4007 x_set_menu_resources_from_menu_face (f
, widget
)
4011 /* Realized faces may have been removed on frame F, e.g. because of
4012 face attribute changes. Recompute them, if necessary, since we
4013 will need the `menu' face. */
4014 if (f
->face_cache
->used
== 0)
4015 recompute_basic_faces (f
);
4018 xl_set_menu_resources_from_menu_face (f
, widget
);
4021 xm_set_menu_resources_from_menu_face (f
, widget
);
4025 #endif /* USE_X_TOOLKIT */
4027 #endif /* HAVE_X_WINDOWS */
4031 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4032 Sinternal_get_lisp_face_attribute
,
4034 "Return face attribute KEYWORD of face SYMBOL.\n\
4035 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4036 face attribute name, signal an error.\n\
4037 If the optional argument FRAME is given, report on face FACE in that\n\
4038 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4039 frames). If FRAME is omitted or nil, use the selected frame.")
4040 (symbol
, keyword
, frame
)
4041 Lisp_Object symbol
, keyword
, frame
;
4043 Lisp_Object lface
, value
= Qnil
;
4045 CHECK_SYMBOL (symbol
, 0);
4046 CHECK_SYMBOL (keyword
, 1);
4049 lface
= lface_from_face_name (NULL
, symbol
, 1);
4053 frame
= selected_frame
;
4054 CHECK_LIVE_FRAME (frame
, 2);
4055 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4058 if (EQ (keyword
, QCfamily
))
4059 value
= LFACE_FAMILY (lface
);
4060 else if (EQ (keyword
, QCheight
))
4061 value
= LFACE_HEIGHT (lface
);
4062 else if (EQ (keyword
, QCweight
))
4063 value
= LFACE_WEIGHT (lface
);
4064 else if (EQ (keyword
, QCslant
))
4065 value
= LFACE_SLANT (lface
);
4066 else if (EQ (keyword
, QCunderline
))
4067 value
= LFACE_UNDERLINE (lface
);
4068 else if (EQ (keyword
, QCoverline
))
4069 value
= LFACE_OVERLINE (lface
);
4070 else if (EQ (keyword
, QCstrike_through
))
4071 value
= LFACE_STRIKE_THROUGH (lface
);
4072 else if (EQ (keyword
, QCbox
))
4073 value
= LFACE_BOX (lface
);
4074 else if (EQ (keyword
, QCinverse_video
)
4075 || EQ (keyword
, QCreverse_video
))
4076 value
= LFACE_INVERSE (lface
);
4077 else if (EQ (keyword
, QCforeground
))
4078 value
= LFACE_FOREGROUND (lface
);
4079 else if (EQ (keyword
, QCbackground
))
4080 value
= LFACE_BACKGROUND (lface
);
4081 else if (EQ (keyword
, QCstipple
))
4082 value
= LFACE_STIPPLE (lface
);
4083 else if (EQ (keyword
, QCwidth
))
4084 value
= LFACE_SWIDTH (lface
);
4086 signal_error ("Invalid face attribute name", keyword
);
4092 DEFUN ("internal-lisp-face-attribute-values",
4093 Finternal_lisp_face_attribute_values
,
4094 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4095 "Return a list of valid discrete values for face attribute ATTR.\n\
4096 Value is nil if ATTR doesn't have a discrete set of valid values.")
4100 Lisp_Object result
= Qnil
;
4102 CHECK_SYMBOL (attr
, 0);
4104 if (EQ (attr
, QCweight
)
4105 || EQ (attr
, QCslant
)
4106 || EQ (attr
, QCwidth
))
4108 /* Extract permissible symbols from tables. */
4109 struct table_entry
*table
;
4112 if (EQ (attr
, QCweight
))
4113 table
= weight_table
, dim
= DIM (weight_table
);
4114 else if (EQ (attr
, QCslant
))
4115 table
= slant_table
, dim
= DIM (slant_table
);
4117 table
= swidth_table
, dim
= DIM (swidth_table
);
4119 for (i
= 0; i
< dim
; ++i
)
4121 Lisp_Object symbol
= *table
[i
].symbol
;
4122 Lisp_Object tail
= result
;
4125 && !EQ (XCAR (tail
), symbol
))
4129 result
= Fcons (symbol
, result
);
4132 else if (EQ (attr
, QCunderline
))
4133 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4134 else if (EQ (attr
, QCoverline
))
4135 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4136 else if (EQ (attr
, QCstrike_through
))
4137 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4138 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4139 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4145 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4146 Sinternal_merge_in_global_face
, 2, 2, 0,
4147 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4149 Lisp_Object face
, frame
;
4151 Lisp_Object global_lface
, local_lface
;
4152 CHECK_LIVE_FRAME (frame
, 1);
4153 global_lface
= lface_from_face_name (NULL
, face
, 1);
4154 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4155 if (NILP (local_lface
))
4156 local_lface
= Finternal_make_lisp_face (face
, frame
);
4157 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4158 XVECTOR (local_lface
)->contents
);
4163 /* The following function is implemented for compatibility with 20.2.
4164 The function is used in x-resolve-fonts when it is asked to
4165 return fonts with the same size as the font of a face. This is
4166 done in fontset.el. */
4168 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4169 "Return the font name of face FACE, or nil if it is unspecified.\n\
4170 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4171 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4172 The font default for a face is either nil, or a list\n\
4173 of the form (bold), (italic) or (bold italic).\n\
4174 If FRAME is omitted or nil, use the selected frame.")
4176 Lisp_Object face
, frame
;
4180 Lisp_Object result
= Qnil
;
4181 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4183 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4184 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4185 result
= Fcons (Qbold
, result
);
4187 if (!NILP (LFACE_SLANT (lface
))
4188 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4189 result
= Fcons (Qitalic
, result
);
4195 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4196 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
4197 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4198 return build_string (face
->font_name
);
4203 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4204 all attributes are `equal'. Tries to be fast because this function
4205 is called quite often. */
4208 lface_equal_p (v1
, v2
)
4209 Lisp_Object
*v1
, *v2
;
4213 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4215 Lisp_Object a
= v1
[i
];
4216 Lisp_Object b
= v2
[i
];
4218 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4219 and the other is specified. */
4220 equal_p
= XTYPE (a
) == XTYPE (b
);
4229 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4230 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4231 XSTRING (a
)->size
) == 0);
4240 equal_p
= !NILP (Fequal (a
, b
));
4250 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4251 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4252 "True if FACE1 and FACE2 are equal.\n\
4253 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4254 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4255 If FRAME is omitted or nil, use the selected frame.")
4256 (face1
, face2
, frame
)
4257 Lisp_Object face1
, face2
, frame
;
4261 Lisp_Object lface1
, lface2
;
4266 /* Don't use check_x_frame here because this function is called
4267 before X frames exist. At that time, if FRAME is nil,
4268 selected_frame will be used which is the frame dumped with
4269 Emacs. That frame is not an X frame. */
4270 f
= frame_or_selected_frame (frame
, 2);
4272 lface1
= lface_from_face_name (NULL
, face1
, 1);
4273 lface2
= lface_from_face_name (NULL
, face2
, 1);
4274 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4275 XVECTOR (lface2
)->contents
);
4276 return equal_p
? Qt
: Qnil
;
4280 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4281 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4282 "True if FACE has no attribute specified.\n\
4283 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4284 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4285 If FRAME is omitted or nil, use the selected frame.")
4287 Lisp_Object face
, frame
;
4294 frame
= selected_frame
;
4295 CHECK_LIVE_FRAME (frame
, 0);
4299 lface
= lface_from_face_name (NULL
, face
, 1);
4301 lface
= lface_from_face_name (f
, face
, 1);
4303 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4304 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4307 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4311 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4313 "Return an alist of frame-local faces defined on FRAME.\n\
4314 For internal use only.")
4318 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4319 return f
->face_alist
;
4323 /* Return a hash code for Lisp string STRING with case ignored. Used
4324 below in computing a hash value for a Lisp face. */
4326 static INLINE
unsigned
4327 hash_string_case_insensitive (string
)
4332 xassert (STRINGP (string
));
4333 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4334 hash
= (hash
<< 1) ^ tolower (*s
);
4339 /* Return a hash code for face attribute vector V. */
4341 static INLINE
unsigned
4345 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4346 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4347 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4348 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4349 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4350 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4351 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4355 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4356 considering charsets/registries). They do if they specify the same
4357 family, point size, weight, width and slant. Both LFACE1 and
4358 LFACE2 must be fully-specified. */
4361 lface_same_font_attributes_p (lface1
, lface2
)
4362 Lisp_Object
*lface1
, *lface2
;
4364 xassert (lface_fully_specified_p (lface1
)
4365 && lface_fully_specified_p (lface2
));
4366 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4367 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4368 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4369 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4370 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4371 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4372 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4377 /***********************************************************************
4379 ***********************************************************************/
4381 /* Allocate and return a new realized face for Lisp face attribute
4382 vector ATTR, charset CHARSET, and registry REGISTRY. */
4384 static struct face
*
4385 make_realized_face (attr
, charset
, registry
)
4388 Lisp_Object registry
;
4390 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4391 bzero (face
, sizeof *face
);
4392 face
->charset
= charset
;
4393 face
->registry
= registry
;
4394 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4399 /* Free realized face FACE, including its X resources. FACE may
4403 free_realized_face (f
, face
)
4409 #ifdef HAVE_X_WINDOWS
4414 x_free_gc (f
, face
->gc
);
4418 free_face_colors (f
, face
);
4419 x_destroy_bitmap (f
, face
->stipple
);
4421 #endif /* HAVE_X_WINDOWS */
4428 /* Prepare face FACE for subsequent display on frame F. This
4429 allocated GCs if they haven't been allocated yet or have been freed
4430 by clearing the face cache. */
4433 prepare_face_for_display (f
, face
)
4437 #ifdef HAVE_X_WINDOWS
4438 xassert (FRAME_X_P (f
));
4443 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4445 xgcv
.foreground
= face
->foreground
;
4446 xgcv
.background
= face
->background
;
4447 xgcv
.graphics_exposures
= False
;
4449 /* The font of FACE may be null if we couldn't load it. */
4452 xgcv
.font
= face
->font
->fid
;
4459 xgcv
.fill_style
= FillOpaqueStippled
;
4460 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4461 mask
|= GCFillStyle
| GCStipple
;
4464 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4471 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4472 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4473 ISO8859-1 if the ASCII face suffices. */
4476 face_suitable_for_iso8859_1_p (face
)
4479 int len
= strlen (face
->font_name
);
4480 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4484 /* Value is non-zero if FACE is suitable for displaying characters
4485 of CHARSET. CHARSET < 0 means unibyte text. */
4488 face_suitable_for_charset_p (face
, charset
)
4496 if (EQ (face
->registry
, Vface_default_registry
)
4497 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4500 else if (face
->charset
== charset
)
4502 else if (face
->charset
== CHARSET_ASCII
4503 && charset
== charset_latin_iso8859_1
)
4504 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4505 else if (face
->charset
== charset_latin_iso8859_1
4506 && charset
== CHARSET_ASCII
)
4514 /***********************************************************************
4516 ***********************************************************************/
4518 /* Return a new face cache for frame F. */
4520 static struct face_cache
*
4524 struct face_cache
*c
;
4527 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4528 bzero (c
, sizeof *c
);
4529 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4530 c
->buckets
= (struct face
**) xmalloc (size
);
4531 bzero (c
->buckets
, size
);
4533 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4539 /* Clear out all graphics contexts for all realized faces, except for
4540 the basic faces. This should be done from time to time just to avoid
4541 keeping too many graphics contexts that are no longer needed. */
4545 struct face_cache
*c
;
4547 if (c
&& FRAME_X_P (c
->f
))
4549 #ifdef HAVE_X_WINDOWS
4551 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4553 struct face
*face
= c
->faces_by_id
[i
];
4554 if (face
&& face
->gc
)
4556 x_free_gc (c
->f
, face
->gc
);
4560 #endif /* HAVE_X_WINDOWS */
4565 /* Free all realized faces in face cache C, including basic faces. C
4566 may be null. If faces are freed, make sure the frame's current
4567 matrix is marked invalid, so that a display caused by an expose
4568 event doesn't try to use faces we destroyed. */
4571 free_realized_faces (c
)
4572 struct face_cache
*c
;
4577 struct frame
*f
= c
->f
;
4579 for (i
= 0; i
< c
->used
; ++i
)
4581 free_realized_face (f
, c
->faces_by_id
[i
]);
4582 c
->faces_by_id
[i
] = NULL
;
4586 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4587 bzero (c
->buckets
, size
);
4589 /* Must do a thorough redisplay the next time. Mark current
4590 matrices as invalid because they will reference faces freed
4591 above. This function is also called when a frame is
4592 destroyed. In this case, the root window of F is nil. */
4593 if (WINDOWP (f
->root_window
))
4595 clear_current_matrices (f
);
4596 ++windows_or_buffers_changed
;
4602 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4603 This is done after attributes of a named face have been changed,
4604 because we can't tell which realized faces depend on that face. */
4607 free_all_realized_faces (frame
)
4613 FOR_EACH_FRAME (rest
, frame
)
4614 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4617 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4621 /* Free face cache C and faces in it, including their X resources. */
4625 struct face_cache
*c
;
4629 free_realized_faces (c
);
4631 xfree (c
->faces_by_id
);
4637 /* Cache realized face FACE in face cache C. HASH is the hash value
4638 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4639 collision list of the face hash table of C. This is done because
4640 otherwise lookup_face would find FACE for every charset, even if
4641 faces with the same attributes but for specific charsets exist. */
4644 cache_face (c
, face
, hash
)
4645 struct face_cache
*c
;
4649 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4653 if (face
->fontset
>= 0)
4655 struct face
*last
= c
->buckets
[i
];
4666 c
->buckets
[i
] = face
;
4667 face
->prev
= face
->next
= NULL
;
4673 face
->next
= c
->buckets
[i
];
4675 face
->next
->prev
= face
;
4676 c
->buckets
[i
] = face
;
4679 /* Find a free slot in C->faces_by_id and use the index of the free
4680 slot as FACE->id. */
4681 for (i
= 0; i
< c
->used
; ++i
)
4682 if (c
->faces_by_id
[i
] == NULL
)
4686 /* Maybe enlarge C->faces_by_id. */
4687 if (i
== c
->used
&& c
->used
== c
->size
)
4689 int new_size
= 2 * c
->size
;
4690 int sz
= new_size
* sizeof *c
->faces_by_id
;
4691 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4696 /* Check that FACE got a unique id. */
4701 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4702 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4708 #endif /* GLYPH_DEBUG */
4710 c
->faces_by_id
[i
] = face
;
4716 /* Remove face FACE from cache C. */
4719 uncache_face (c
, face
)
4720 struct face_cache
*c
;
4723 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4726 face
->prev
->next
= face
->next
;
4728 c
->buckets
[i
] = face
->next
;
4731 face
->next
->prev
= face
->prev
;
4733 c
->faces_by_id
[face
->id
] = NULL
;
4734 if (face
->id
== c
->used
)
4739 /* Look up a realized face with face attributes ATTR in the face cache
4740 of frame F. The face will be used to display characters of
4741 CHARSET. CHARSET < 0 means the face will be used to display
4742 unibyte text. The value of face-default-registry is used to choose
4743 a font for the face in that case. Value is the ID of the face
4744 found. If no suitable face is found, realize a new one. */
4747 lookup_face (f
, attr
, charset
)
4752 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4757 xassert (c
!= NULL
);
4758 check_lface_attrs (attr
);
4760 /* Look up ATTR in the face cache. */
4761 hash
= lface_hash (attr
);
4762 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4764 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4765 if (face
->hash
== hash
4766 && (!FRAME_WINDOW_P (f
)
4767 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4768 && lface_equal_p (face
->lface
, attr
))
4771 /* If not found, realize a new face. */
4774 face
= realize_face (c
, attr
, charset
);
4775 cache_face (c
, face
, hash
);
4779 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4781 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4782 #endif /* GLYPH_DEBUG */
4788 /* Return the face id of the realized face for named face SYMBOL on
4789 frame F suitable for displaying characters from CHARSET. CHARSET <
4790 0 means unibyte text. */
4793 lookup_named_face (f
, symbol
, charset
)
4798 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4799 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4800 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4802 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4803 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4804 merge_face_vectors (symbol_attrs
, attrs
);
4805 return lookup_face (f
, attrs
, charset
);
4809 /* Return the ID of the realized ASCII face of Lisp face with ID
4810 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4813 ascii_face_of_lisp_face (f
, lface_id
)
4819 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4821 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4822 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4831 /* Return a face for charset ASCII that is like the face with id
4832 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4833 STEPS < 0 means larger. Value is the id of the face. */
4836 smaller_face (f
, face_id
, steps
)
4840 #ifdef HAVE_X_WINDOWS
4842 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4843 int pt
, last_pt
, last_height
;
4846 struct face
*new_face
;
4848 /* If not called for an X frame, just return the original face. */
4849 if (FRAME_TERMCAP_P (f
))
4852 /* Try in increments of 1/2 pt. */
4853 delta
= steps
< 0 ? 5 : -5;
4854 steps
= abs (steps
);
4856 face
= FACE_FROM_ID (f
, face_id
);
4857 bcopy (face
->lface
, attrs
, sizeof attrs
);
4858 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4859 new_face_id
= face_id
;
4860 last_height
= FONT_HEIGHT (face
->font
);
4864 /* Give up if we cannot find a font within 10pt. */
4865 && abs (last_pt
- pt
) < 100)
4867 /* Look up a face for a slightly smaller/larger font. */
4869 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4870 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4871 new_face
= FACE_FROM_ID (f
, new_face_id
);
4873 /* If height changes, count that as one step. */
4874 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4877 last_height
= FONT_HEIGHT (new_face
->font
);
4884 #else /* not HAVE_X_WINDOWS */
4888 #endif /* not HAVE_X_WINDOWS */
4892 /* Return a face for charset ASCII that is like the face with id
4893 FACE_ID on frame F, but has height HEIGHT. */
4896 face_with_height (f
, face_id
, height
)
4901 #ifdef HAVE_X_WINDOWS
4903 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4905 if (FRAME_TERMCAP_P (f
)
4909 face
= FACE_FROM_ID (f
, face_id
);
4910 bcopy (face
->lface
, attrs
, sizeof attrs
);
4911 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4912 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4913 #endif /* HAVE_X_WINDOWS */
4918 /* Return the face id of the realized face for named face SYMBOL on
4919 frame F suitable for displaying characters from CHARSET (CHARSET <
4920 0 means unibyte text), and use attributes of the face FACE_ID for
4921 attributes that aren't completely specified by SYMBOL. This is
4922 like lookup_named_face, except that the default attributes come
4923 from FACE_ID, not from the default face. FACE_ID is assumed to
4924 be already realized. */
4927 lookup_derived_face (f
, symbol
, charset
, face_id
)
4933 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4934 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4935 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4940 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4941 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4942 merge_face_vectors (symbol_attrs
, attrs
);
4943 return lookup_face (f
, attrs
, charset
);
4948 /***********************************************************************
4950 ***********************************************************************/
4952 DEFUN ("internal-set-font-selection-order",
4953 Finternal_set_font_selection_order
,
4954 Sinternal_set_font_selection_order
, 1, 1, 0,
4955 "Set font selection order for face font selection to ORDER.\n\
4956 ORDER must be a list of length 4 containing the symbols `:width',\n\
4957 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4958 first in ORDER are matched first, e.g. if `:height' appears before\n\
4959 `:weight' in ORDER, font selection first tries to find a font with\n\
4960 a suitable height, and then tries to match the font weight.\n\
4969 CHECK_LIST (order
, 0);
4970 bzero (indices
, sizeof indices
);
4974 CONSP (list
) && i
< DIM (indices
);
4975 list
= XCDR (list
), ++i
)
4977 Lisp_Object attr
= XCAR (list
);
4980 if (EQ (attr
, QCwidth
))
4982 else if (EQ (attr
, QCheight
))
4983 xlfd
= XLFD_POINT_SIZE
;
4984 else if (EQ (attr
, QCweight
))
4986 else if (EQ (attr
, QCslant
))
4991 if (indices
[i
] != 0)
4997 || i
!= DIM (indices
)
5002 signal_error ("Invalid font sort order", order
);
5004 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5006 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5007 free_all_realized_faces (Qnil
);
5014 DEFUN ("internal-set-alternative-font-family-alist",
5015 Finternal_set_alternative_font_family_alist
,
5016 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5017 "Define alternative font families to try in face font selection.\n\
5018 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5019 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5020 be found. Value is ALIST.")
5024 CHECK_LIST (alist
, 0);
5025 Vface_alternative_font_family_alist
= alist
;
5026 free_all_realized_faces (Qnil
);
5031 #ifdef HAVE_X_WINDOWS
5033 /* Return the X registry and encoding of font name FONT_NAME on frame F.
5034 Value is nil if not successful. */
5037 deduce_unibyte_registry (f
, font_name
)
5041 struct font_name font
;
5042 Lisp_Object registry
= Qnil
;
5044 font
.name
= STRDUPA (font_name
);
5045 if (split_font_name (f
, &font
, 0))
5049 /* Extract registry and encoding. */
5050 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
5051 + strlen (font
.fields
[XLFD_ENCODING
])
5053 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
5054 strcat (buffer
, "-");
5055 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
5056 registry
= build_string (buffer
);
5063 /* Value is non-zero if FONT is the name of a scalable font. The
5064 X11R6 XLFD spec says that point size, pixel size, and average width
5065 are zero for scalable fonts. Intlfonts contain at least one
5066 scalable font ("*-muleindian-1") for which this isn't true, so we
5067 just test average width. */
5070 font_scalable_p (font
)
5071 struct font_name
*font
;
5073 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5074 return *s
== '0' && *(s
+ 1) == '\0';
5078 /* Value is non-zero if FONT1 is a better match for font attributes
5079 VALUES than FONT2. VALUES is an array of face attribute values in
5080 font sort order. COMPARE_PT_P zero means don't compare point
5084 better_font_p (values
, font1
, font2
, compare_pt_p
)
5086 struct font_name
*font1
, *font2
;
5091 for (i
= 0; i
< 4; ++i
)
5093 int xlfd_idx
= font_sort_order
[i
];
5095 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5097 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5098 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5100 if (delta1
> delta2
)
5102 else if (delta1
< delta2
)
5106 /* The difference may be equal because, e.g., the face
5107 specifies `italic' but we have only `regular' and
5108 `oblique'. Prefer `oblique' in this case. */
5109 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5110 && font1
->numeric
[xlfd_idx
] > values
[i
]
5111 && font2
->numeric
[xlfd_idx
] < values
[i
])
5123 /* Value is non-zero if FONT is an exact match for face attributes in
5124 SPECIFIED. SPECIFIED is an array of face attribute values in font
5128 exact_face_match_p (specified
, font
)
5130 struct font_name
*font
;
5134 for (i
= 0; i
< 4; ++i
)
5135 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5142 /* Value is the name of a scaled font, generated from scalable font
5143 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5144 Value is allocated from heap. */
5147 build_scalable_font_name (f
, font
, specified_pt
)
5149 struct font_name
*font
;
5152 char point_size
[20], pixel_size
[20];
5154 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5157 /* If scalable font is for a specific resolution, compute
5158 the point size we must specify from the resolution of
5159 the display and the specified resolution of the font. */
5160 if (font
->numeric
[XLFD_RESY
] != 0)
5162 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5163 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5168 pixel_value
= resy
/ 720.0 * pt
;
5171 /* Set point size of the font. */
5172 sprintf (point_size
, "%d", (int) pt
);
5173 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5174 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5176 /* Set pixel size. */
5177 sprintf (pixel_size
, "%d", pixel_value
);
5178 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5179 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5181 /* If font doesn't specify its resolution, use the
5182 resolution of the display. */
5183 if (font
->numeric
[XLFD_RESY
] == 0)
5186 sprintf (buffer
, "%d", (int) resy
);
5187 font
->fields
[XLFD_RESY
] = buffer
;
5188 font
->numeric
[XLFD_RESY
] = resy
;
5191 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5194 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5195 sprintf (buffer
, "%d", resx
);
5196 font
->fields
[XLFD_RESX
] = buffer
;
5197 font
->numeric
[XLFD_RESX
] = resx
;
5200 return build_font_name (font
);
5204 /* Value is non-zero if we are allowed to use scalable font FONT. We
5205 can't run a Lisp function here since this function may be called
5206 with input blocked. */
5209 may_use_scalable_font_p (font
, name
)
5210 struct font_name
*font
;
5213 if (EQ (Vscalable_fonts_allowed
, Qt
))
5215 else if (CONSP (Vscalable_fonts_allowed
))
5217 Lisp_Object tail
, regexp
;
5219 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5221 regexp
= XCAR (tail
);
5222 if (STRINGP (regexp
)
5223 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5231 #endif /* SCALABLE_FONTS != 0 */
5234 /* Return the name of the best matching font for face attributes
5235 ATTRS in the array of font_name structures FONTS which contains
5236 NFONTS elements. Value is a font name which is allocated from
5237 the heap. FONTS is freed by this function. */
5240 best_matching_font (f
, attrs
, fonts
, nfonts
)
5243 struct font_name
*fonts
;
5247 struct font_name
*best
;
5255 /* Make specified font attributes available in `specified',
5256 indexed by sort order. */
5257 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5259 int xlfd_idx
= font_sort_order
[i
];
5261 if (xlfd_idx
== XLFD_SWIDTH
)
5262 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5263 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5264 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5265 else if (xlfd_idx
== XLFD_WEIGHT
)
5266 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5267 else if (xlfd_idx
== XLFD_SLANT
)
5268 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5278 /* Start with the first non-scalable font in the list. */
5279 for (i
= 0; i
< nfonts
; ++i
)
5280 if (!font_scalable_p (fonts
+ i
))
5283 /* Find the best match among the non-scalable fonts. */
5288 for (i
= 1; i
< nfonts
; ++i
)
5289 if (!font_scalable_p (fonts
+ i
)
5290 && better_font_p (specified
, fonts
+ i
, best
, 1))
5294 exact_p
= exact_face_match_p (specified
, best
);
5303 /* Unless we found an exact match among non-scalable fonts, see if
5304 we can find a better match among scalable fonts. */
5307 /* A scalable font is better if
5309 1. its weight, slant, swidth attributes are better, or.
5311 2. the best non-scalable font doesn't have the required
5312 point size, and the scalable fonts weight, slant, swidth
5315 int non_scalable_has_exact_height_p
;
5317 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5318 non_scalable_has_exact_height_p
= 1;
5320 non_scalable_has_exact_height_p
= 0;
5322 for (i
= 0; i
< nfonts
; ++i
)
5323 if (font_scalable_p (fonts
+ i
))
5326 || better_font_p (specified
, fonts
+ i
, best
, 0)
5327 || (!non_scalable_has_exact_height_p
5328 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5333 if (font_scalable_p (best
))
5334 font_name
= build_scalable_font_name (f
, best
, pt
);
5336 font_name
= build_font_name (best
);
5338 #else /* !SCALABLE_FONTS */
5340 /* Find the best non-scalable font. */
5343 for (i
= 1; i
< nfonts
; ++i
)
5345 xassert (!font_scalable_p (fonts
+ i
));
5346 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5350 font_name
= build_font_name (best
);
5352 #endif /* !SCALABLE_FONTS */
5354 /* Free font_name structures. */
5355 free_font_names (fonts
, nfonts
);
5361 /* Try to get a list of fonts on frame F with font family FAMILY and
5362 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5363 of font_name structures for the fonts matched. Value is the number
5367 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5370 char *pattern
, *family
, *registry
;
5371 struct font_name
**fonts
;
5376 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5378 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5384 /* Try alternative font families from
5385 Vface_alternative_font_family_alist. */
5386 alter
= Fassoc (build_string (family
),
5387 Vface_alternative_font_family_alist
);
5389 for (alter
= XCDR (alter
);
5390 CONSP (alter
) && nfonts
== 0;
5391 alter
= XCDR (alter
))
5393 if (STRINGP (XCAR (alter
)))
5395 family
= LSTRDUPA (XCAR (alter
));
5396 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5400 /* Try font family of the default face or "fixed". */
5403 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5405 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5408 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5411 /* Try any family with the given registry. */
5413 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5420 /* Return the registry and encoding pattern that fonts for CHARSET
5421 should match. Value is allocated from the heap. */
5424 x_charset_registry (charset
)
5427 Lisp_Object prop
, charset_plist
;
5430 /* Get registry and encoding from the charset's plist. */
5431 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5432 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5436 if (index (XSTRING (prop
)->data
, '-'))
5437 registry
= xstrdup (XSTRING (prop
)->data
);
5440 /* If registry doesn't contain a `-', make it a pattern. */
5441 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5442 strcpy (registry
, XSTRING (prop
)->data
);
5443 strcat (registry
, "*-*");
5446 else if (STRINGP (Vface_default_registry
))
5447 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5449 registry
= xstrdup ("iso8859-1");
5455 /* Return the fontset id of the fontset name or alias name given by
5456 the family attribute of ATTRS on frame F. Value is -1 if the
5457 family attribute of ATTRS doesn't name a fontset. */
5460 face_fontset (f
, attrs
)
5464 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5467 name
= Fquery_fontset (name
, Qnil
);
5471 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5477 /* Get the font to use for the face realizing the fully-specified Lisp
5478 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5479 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5480 in this case. Value is the font name which is allocated from the
5481 heap (which means that it must be freed eventually). */
5484 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5488 Lisp_Object unibyte_registry
;
5490 struct font_name
*fonts
;
5494 /* ATTRS must be fully-specified. */
5495 xassert (lface_fully_specified_p (attrs
));
5497 if (STRINGP (unibyte_registry
))
5498 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5500 registry
= x_charset_registry (charset
);
5502 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5504 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5508 /* Choose a font to use on frame F to display CHARSET using FONTSET
5509 with Lisp face attributes specified by ATTRS. CHARSET may be any
5510 valid charset. CHARSET < 0 means unibyte text. If the fontset
5511 doesn't contain a font pattern for charset, use the pattern for
5512 CHARSET_ASCII. Value is the font name which is allocated from the
5513 heap and must be freed by the caller. */
5516 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5519 int fontset
, charset
;
5522 char *font_name
= NULL
;
5523 struct fontset_info
*fontset_info
;
5524 struct font_name
*fonts
;
5527 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5529 /* For unibyte text, use the ASCII font of the fontset. Using the
5530 ASCII font seems to be the most reasonable thing we can do in
5533 charset
= CHARSET_ASCII
;
5535 /* Get the font name pattern to use for CHARSET from the fontset. */
5536 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5537 pattern
= fontset_info
->fontname
[charset
];
5539 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5542 /* Get a list of fonts matching that pattern and choose the
5543 best match for the specified face attributes from it. */
5544 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5545 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5549 #endif /* HAVE_X_WINDOWS */
5553 /***********************************************************************
5555 ***********************************************************************/
5557 /* Realize basic faces on frame F. Value is zero if frame parameters
5558 of F don't contain enough information needed to realize the default
5562 realize_basic_faces (f
)
5567 if (realize_default_face (f
))
5569 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5570 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5571 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5572 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5573 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5574 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5575 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5576 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5577 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5585 /* Realize the default face on frame F. If the face is not fully
5586 specified, make it fully-specified. Attributes of the default face
5587 that are not explicitly specified are taken from frame parameters. */
5590 realize_default_face (f
)
5593 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5595 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5596 Lisp_Object unibyte_registry
;
5597 Lisp_Object frame_font
;
5601 /* If the `default' face is not yet known, create it. */
5602 lface
= lface_from_face_name (f
, Qdefault
, 0);
5606 XSETFRAME (frame
, f
);
5607 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5610 #ifdef HAVE_X_WINDOWS
5613 /* Set frame_font to the value of the `font' frame parameter. */
5614 frame_font
= Fassq (Qfont
, f
->param_alist
);
5615 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5616 frame_font
= XCDR (frame_font
);
5618 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5621 /* If frame_font is a fontset name, don't use that for
5622 determining font-related attributes of the default face
5623 because it is just an artificial name. Use the ASCII font of
5624 the fontset, instead. */
5625 struct font_info
*font_info
;
5626 struct font_name font
;
5629 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5633 /* Set weight etc. from the ASCII font. */
5634 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0, 0))
5637 /* Remember registry and encoding of the frame font. */
5638 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5639 if (STRINGP (unibyte_registry
))
5640 Vface_default_registry
= unibyte_registry
;
5642 Vface_default_registry
= build_string ("iso8859-1");
5644 /* But set the family to the fontset alias name. Implementation
5645 note: When a font is passed to Emacs via `-fn FONT', a
5646 fontset is created in `x-win.el' whose name ends in
5647 `fontset-startup'. This fontset has an alias name that is
5648 equal to frame_font. */
5649 xassert (STRINGP (frame_font
));
5650 font
.name
= LSTRDUPA (frame_font
);
5652 if (!split_font_name (f
, &font
, 1)
5653 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5654 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5655 LFACE_FAMILY (lface
) = frame_font
;
5659 /* Frame parameters contain a real font. Fill default face
5660 attributes from that font. */
5661 if (!set_lface_from_font_name (f
, lface
,
5662 XSTRING (frame_font
)->data
, 0, 0))
5665 /* Remember registry and encoding of the frame font. */
5667 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5668 if (STRINGP (unibyte_registry
))
5669 Vface_default_registry
= unibyte_registry
;
5671 Vface_default_registry
= build_string ("iso8859-1");
5674 #endif /* HAVE_X_WINDOWS */
5676 if (!FRAME_WINDOW_P (f
))
5678 LFACE_FAMILY (lface
) = build_string ("default");
5679 LFACE_SWIDTH (lface
) = Qnormal
;
5680 LFACE_HEIGHT (lface
) = make_number (1);
5681 LFACE_WEIGHT (lface
) = Qnormal
;
5682 LFACE_SLANT (lface
) = Qnormal
;
5685 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5686 LFACE_UNDERLINE (lface
) = Qnil
;
5688 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5689 LFACE_OVERLINE (lface
) = Qnil
;
5691 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5692 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5694 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5695 LFACE_BOX (lface
) = Qnil
;
5697 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5698 LFACE_INVERSE (lface
) = Qnil
;
5700 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5702 /* This function is called so early that colors are not yet
5703 set in the frame parameter list. */
5704 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5706 if (CONSP (color
) && STRINGP (XCDR (color
)))
5707 LFACE_FOREGROUND (lface
) = XCDR (color
);
5708 else if (FRAME_X_P (f
))
5710 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5711 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5716 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5718 /* This function is called so early that colors are not yet
5719 set in the frame parameter list. */
5720 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5721 if (CONSP (color
) && STRINGP (XCDR (color
)))
5722 LFACE_BACKGROUND (lface
) = XCDR (color
);
5723 else if (FRAME_X_P (f
))
5725 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5726 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5731 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5732 LFACE_STIPPLE (lface
) = Qnil
;
5734 /* Realize the face; it must be fully-specified now. */
5735 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5736 check_lface (lface
);
5737 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5738 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5740 /* Remove the former default face. */
5741 if (c
->used
> DEFAULT_FACE_ID
)
5743 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5744 uncache_face (c
, default_face
);
5745 free_realized_face (f
, default_face
);
5748 /* Insert the new default face. */
5749 cache_face (c
, face
, lface_hash (attrs
));
5750 xassert (face
->id
== DEFAULT_FACE_ID
);
5755 /* Realize basic faces other than the default face in face cache C.
5756 SYMBOL is the face name, ID is the face id the realized face must
5757 have. The default face must have been realized already. */
5760 realize_named_face (f
, symbol
, id
)
5765 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5766 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5767 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5768 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5769 struct face
*new_face
;
5771 /* The default face must exist and be fully specified. */
5772 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5773 check_lface_attrs (attrs
);
5774 xassert (lface_fully_specified_p (attrs
));
5776 /* If SYMBOL isn't know as a face, create it. */
5780 XSETFRAME (frame
, f
);
5781 lface
= Finternal_make_lisp_face (symbol
, frame
);
5784 /* Merge SYMBOL's face with the default face. */
5785 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5786 merge_face_vectors (symbol_attrs
, attrs
);
5788 /* Realize the face. */
5789 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5791 /* Remove the former face. */
5794 struct face
*old_face
= c
->faces_by_id
[id
];
5795 uncache_face (c
, old_face
);
5796 free_realized_face (f
, old_face
);
5799 /* Insert the new face. */
5800 cache_face (c
, new_face
, lface_hash (attrs
));
5801 xassert (new_face
->id
== id
);
5805 /* Realize the fully-specified face with attributes ATTRS in face
5806 cache C for character set CHARSET or for unibyte text if CHARSET <
5807 0. Value is a pointer to the newly created realized face. */
5809 static struct face
*
5810 realize_face (c
, attrs
, charset
)
5811 struct face_cache
*c
;
5817 /* LFACE must be fully specified. */
5818 xassert (c
!= NULL
);
5819 check_lface_attrs (attrs
);
5821 if (FRAME_X_P (c
->f
))
5822 face
= realize_x_face (c
, attrs
, charset
);
5823 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5824 face
= realize_tty_face (c
, attrs
, charset
);
5832 /* Realize the fully-specified face with attributes ATTRS in face
5833 cache C for character set CHARSET or for unibyte text if CHARSET <
5834 0. Do it for X frame C->f. Value is a pointer to the newly
5835 created realized face. */
5837 static struct face
*
5838 realize_x_face (c
, attrs
, charset
)
5839 struct face_cache
*c
;
5843 #ifdef HAVE_X_WINDOWS
5844 struct face
*face
, *default_face
;
5846 Lisp_Object stipple
, overline
, strike_through
, box
;
5847 Lisp_Object unibyte_registry
;
5848 struct gcpro gcpro1
;
5850 xassert (FRAME_X_P (c
->f
));
5852 /* If realizing a face for use in unibyte text, get the X registry
5853 and encoding to use from Vface_default_registry. */
5855 unibyte_registry
= (STRINGP (Vface_default_registry
)
5856 ? Vface_default_registry
5857 : build_string ("iso8859-1"));
5859 unibyte_registry
= Qnil
;
5860 GCPRO1 (unibyte_registry
);
5862 /* Allocate a new realized face. */
5863 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5866 /* Determine the font to use. Most of the time, the font will be
5867 the same as the font of the default face, so try that first. */
5868 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5870 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5871 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5873 face
->font
= default_face
->font
;
5874 face
->fontset
= default_face
->fontset
;
5875 face
->font_info_id
= default_face
->font_info_id
;
5876 face
->font_name
= default_face
->font_name
;
5877 face
->registry
= default_face
->registry
;
5879 else if (charset
>= 0)
5881 /* For all charsets, we use our own font selection functions to
5882 choose a best matching font for the specified face
5883 attributes. If the face specifies a fontset alias name, the
5884 fontset determines the font name pattern, otherwise we
5885 construct a font pattern from face attributes and charset. */
5887 char *font_name
= NULL
;
5888 int fontset
= face_fontset (f
, attrs
);
5891 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5894 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5898 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5903 /* Unibyte case, and font is not equal to that of the default
5904 face. UNIBYTE_REGISTRY is the X registry and encoding the
5905 font should have. What is a reasonable thing to do if the
5906 user specified a fontset alias name for the face in this
5907 case? We choose a font by taking the ASCII font of the
5908 fontset, but using UNIBYTE_REGISTRY for its registry and
5911 char *font_name
= NULL
;
5912 int fontset
= face_fontset (f
, attrs
);
5915 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5917 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5919 load_face_font_or_fontset (f
, face
, font_name
, -1);
5923 /* Load colors, and set remaining attributes. */
5925 load_face_colors (f
, face
, attrs
);
5928 box
= attrs
[LFACE_BOX_INDEX
];
5931 /* A simple box of line width 1 drawn in color given by
5933 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5935 face
->box
= FACE_SIMPLE_BOX
;
5936 face
->box_line_width
= 1;
5938 else if (INTEGERP (box
))
5940 /* Simple box of specified line width in foreground color of the
5942 xassert (XINT (box
) > 0);
5943 face
->box
= FACE_SIMPLE_BOX
;
5944 face
->box_line_width
= XFASTINT (box
);
5945 face
->box_color
= face
->foreground
;
5946 face
->box_color_defaulted_p
= 1;
5948 else if (CONSP (box
))
5950 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5951 being one of `raised' or `sunken'. */
5952 face
->box
= FACE_SIMPLE_BOX
;
5953 face
->box_color
= face
->foreground
;
5954 face
->box_color_defaulted_p
= 1;
5955 face
->box_line_width
= 1;
5959 Lisp_Object keyword
, value
;
5961 keyword
= XCAR (box
);
5969 if (EQ (keyword
, QCline_width
))
5971 if (INTEGERP (value
) && XINT (value
) > 0)
5972 face
->box_line_width
= XFASTINT (value
);
5974 else if (EQ (keyword
, QCcolor
))
5976 if (STRINGP (value
))
5978 face
->box_color
= load_color (f
, face
, value
,
5980 face
->use_box_color_for_shadows_p
= 1;
5983 else if (EQ (keyword
, QCstyle
))
5985 if (EQ (value
, Qreleased_button
))
5986 face
->box
= FACE_RAISED_BOX
;
5987 else if (EQ (value
, Qpressed_button
))
5988 face
->box
= FACE_SUNKEN_BOX
;
5993 /* Text underline, overline, strike-through. */
5995 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5997 /* Use default color (same as foreground color). */
5998 face
->underline_p
= 1;
5999 face
->underline_defaulted_p
= 1;
6000 face
->underline_color
= 0;
6002 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6004 /* Use specified color. */
6005 face
->underline_p
= 1;
6006 face
->underline_defaulted_p
= 0;
6007 face
->underline_color
6008 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6009 LFACE_UNDERLINE_INDEX
);
6011 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6013 face
->underline_p
= 0;
6014 face
->underline_defaulted_p
= 0;
6015 face
->underline_color
= 0;
6018 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6019 if (STRINGP (overline
))
6021 face
->overline_color
6022 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6023 LFACE_OVERLINE_INDEX
);
6024 face
->overline_p
= 1;
6026 else if (EQ (overline
, Qt
))
6028 face
->overline_color
= face
->foreground
;
6029 face
->overline_color_defaulted_p
= 1;
6030 face
->overline_p
= 1;
6033 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6034 if (STRINGP (strike_through
))
6036 face
->strike_through_color
6037 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6038 LFACE_STRIKE_THROUGH_INDEX
);
6039 face
->strike_through_p
= 1;
6041 else if (EQ (strike_through
, Qt
))
6043 face
->strike_through_color
= face
->foreground
;
6044 face
->strike_through_color_defaulted_p
= 1;
6045 face
->strike_through_p
= 1;
6048 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6049 if (!NILP (stipple
))
6050 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6053 xassert (face
->fontset
< 0);
6054 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
6056 #endif /* HAVE_X_WINDOWS */
6060 /* Realize the fully-specified face with attributes ATTRS in face
6061 cache C for character set CHARSET or for unibyte text if CHARSET <
6062 0. Do it for TTY frame C->f. Value is a pointer to the newly
6063 created realized face. */
6065 static struct face
*
6066 realize_tty_face (c
, attrs
, charset
)
6067 struct face_cache
*c
;
6074 Lisp_Object tty_defined_color_alist
=
6075 Fsymbol_value (intern ("tty-defined-color-alist"));
6076 Lisp_Object tty_color_alist
= intern ("tty-color-alist");
6078 int face_colors_defaulted
= 0;
6080 /* Frame must be a termcap frame. */
6081 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
6083 /* Allocate a new realized face. */
6084 face
= make_realized_face (attrs
, charset
, Qnil
);
6085 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
6087 /* Map face attributes to TTY appearances. We map slant to
6088 dimmed text because we want italic text to appear differently
6089 and because dimmed text is probably used infrequently. */
6090 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6091 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6093 if (weight
> XLFD_WEIGHT_MEDIUM
)
6094 face
->tty_bold_p
= 1;
6095 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6096 face
->tty_dim_p
= 1;
6097 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6098 face
->tty_underline_p
= 1;
6099 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6100 face
->tty_reverse_p
= 1;
6102 /* Map color names to color indices. */
6103 face
->foreground
= FACE_TTY_DEFAULT_FG_COLOR
;
6104 face
->background
= FACE_TTY_DEFAULT_BG_COLOR
;
6106 XSETFRAME (frame
, c
->f
);
6107 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6109 && XSTRING (color
)->size
6110 && !NILP (tty_defined_color_alist
)
6111 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6113 /* Associations in tty-defined-color-alist are of the form
6114 (NAME INDEX R G B). We need the INDEX part. */
6115 face
->foreground
= XINT (XCAR (XCDR (color
)));
6117 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6118 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6120 face
->foreground
= load_color (c
->f
, face
,
6121 attrs
[LFACE_FOREGROUND_INDEX
],
6122 LFACE_FOREGROUND_INDEX
);
6124 /* If the foreground of the default face is the default color,
6125 use the foreground color defined by the frame. */
6126 if (FRAME_MSDOS_P (c
->f
))
6128 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6129 || face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6131 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
6132 attrs
[LFACE_FOREGROUND_INDEX
] =
6133 msdos_stdcolor_name (face
->foreground
);
6134 face_colors_defaulted
= 1;
6136 else if (face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6138 face
->foreground
= FRAME_BACKGROUND_PIXEL (f
);
6139 attrs
[LFACE_FOREGROUND_INDEX
] =
6140 msdos_stdcolor_name (face
->foreground
);
6141 face_colors_defaulted
= 1;
6147 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6149 && XSTRING (color
)->size
6150 && !NILP (tty_defined_color_alist
)
6151 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6153 /* Associations in tty-defined-color-alist are of the form
6154 (NAME INDEX R G B). We need the INDEX part. */
6155 face
->background
= XINT (XCAR (XCDR (color
)));
6157 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6158 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6160 face
->background
= load_color (c
->f
, face
,
6161 attrs
[LFACE_BACKGROUND_INDEX
],
6162 LFACE_BACKGROUND_INDEX
);
6164 /* If the background of the default face is the default color,
6165 use the background color defined by the frame. */
6166 if (FRAME_MSDOS_P (c
->f
))
6168 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6169 || face
->background
== FACE_TTY_DEFAULT_COLOR
)
6171 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
6172 attrs
[LFACE_BACKGROUND_INDEX
] =
6173 msdos_stdcolor_name (face
->background
);
6174 face_colors_defaulted
= 1;
6176 else if (face
->background
== FACE_TTY_DEFAULT_FG_COLOR
)
6178 face
->background
= FRAME_FOREGROUND_PIXEL (f
);
6179 attrs
[LFACE_BACKGROUND_INDEX
] =
6180 msdos_stdcolor_name (face
->background
);
6181 face_colors_defaulted
= 1;
6187 /* Swap colors if face is inverse-video. If the colors are taken
6188 from the frame colors, they are already inverted, since the
6189 frame-creation function calls x-handle-reverse-video. */
6190 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6192 unsigned long tem
= face
->foreground
;
6194 face
->foreground
= face
->background
;
6195 face
->background
= tem
;
6203 /***********************************************************************
6205 ***********************************************************************/
6207 /* Return the ID of the face to use to display character CH with face
6208 property PROP on frame F in current_buffer. */
6211 compute_char_face (f
, ch
, prop
)
6217 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
6219 : CHAR_CHARSET (ch
));
6222 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
6225 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6226 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6227 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6228 merge_face_vector_with_property (f
, attrs
, prop
);
6229 face_id
= lookup_face (f
, attrs
, charset
);
6236 /* Return the face ID associated with buffer position POS for
6237 displaying ASCII characters. Return in *ENDPTR the position at
6238 which a different face is needed, as far as text properties and
6239 overlays are concerned. W is a window displaying current_buffer.
6241 REGION_BEG, REGION_END delimit the region, so it can be
6244 LIMIT is a position not to scan beyond. That is to limit the time
6245 this function can take.
6247 If MOUSE is non-zero, use the character's mouse-face, not its face.
6249 The face returned is suitable for displaying CHARSET_ASCII if
6250 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
6251 the face is suitable for displaying unibyte text. */
6254 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6255 endptr
, limit
, mouse
)
6258 int region_beg
, region_end
;
6263 struct frame
*f
= XFRAME (w
->frame
);
6264 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6265 Lisp_Object prop
, position
;
6267 Lisp_Object
*overlay_vec
;
6270 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6271 Lisp_Object limit1
, end
;
6272 struct face
*default_face
;
6273 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6275 /* W must display the current buffer. We could write this function
6276 to use the frame and buffer of W, but right now it doesn't. */
6277 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6279 XSETFRAME (frame
, f
);
6280 XSETFASTINT (position
, pos
);
6283 if (pos
< region_beg
&& region_beg
< endpos
)
6284 endpos
= region_beg
;
6286 /* Get the `face' or `mouse_face' text property at POS, and
6287 determine the next position at which the property changes. */
6288 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6289 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6290 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6292 endpos
= XINT (end
);
6294 /* Look at properties from overlays. */
6299 /* First try with room for 40 overlays. */
6301 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6302 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6303 &next_overlay
, NULL
);
6305 /* If there are more than 40, make enough space for all, and try
6307 if (noverlays
> len
)
6310 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6311 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6312 &next_overlay
, NULL
);
6315 if (next_overlay
< endpos
)
6316 endpos
= next_overlay
;
6321 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6323 /* Optimize common cases where we can use the default face. */
6326 && !(pos
>= region_beg
&& pos
< region_end
)
6328 || !FRAME_WINDOW_P (f
)
6329 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6330 return DEFAULT_FACE_ID
;
6332 /* Begin with attributes from the default face. */
6333 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6335 /* Merge in attributes specified via text properties. */
6337 merge_face_vector_with_property (f
, attrs
, prop
);
6339 /* Now merge the overlay data. */
6340 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6341 for (i
= 0; i
< noverlays
; i
++)
6346 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6348 merge_face_vector_with_property (f
, attrs
, prop
);
6350 oend
= OVERLAY_END (overlay_vec
[i
]);
6351 oendpos
= OVERLAY_POSITION (oend
);
6352 if (oendpos
< endpos
)
6356 /* If in the region, merge in the region face. */
6357 if (pos
>= region_beg
&& pos
< region_end
)
6359 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6360 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6362 if (region_end
< endpos
)
6363 endpos
= region_end
;
6368 /* Look up a realized face with the given face attributes,
6369 or realize a new one. Charset is ignored for tty frames. */
6370 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6374 /* Compute the face at character position POS in Lisp string STRING on
6375 window W, for charset CHARSET_ASCII.
6377 If STRING is an overlay string, it comes from position BUFPOS in
6378 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6379 not an overlay string. W must display the current buffer.
6380 REGION_BEG and REGION_END give the start and end positions of the
6381 region; both are -1 if no region is visible. BASE_FACE_ID is the
6382 id of the basic face to merge with. It is usually equal to
6383 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6384 for strings displayed in the mode or top line.
6386 Set *ENDPTR to the next position where to check for faces in
6387 STRING; -1 if the face is constant from POS to the end of the
6390 Value is the id of the face to use. The face returned is suitable
6391 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6392 the face is suitable for displaying unibyte text. */
6395 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6396 region_end
, endptr
, base_face_id
)
6400 int region_beg
, region_end
;
6402 enum face_id base_face_id
;
6404 Lisp_Object prop
, position
, end
, limit
;
6405 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6406 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6407 struct face
*base_face
;
6408 int multibyte_p
= STRING_MULTIBYTE (string
);
6410 /* Get the value of the face property at the current position within
6411 STRING. Value is nil if there is no face property. */
6412 XSETFASTINT (position
, pos
);
6413 prop
= Fget_text_property (position
, Qface
, string
);
6415 /* Get the next position at which to check for faces. Value of end
6416 is nil if face is constant all the way to the end of the string.
6417 Otherwise it is a string position where to check faces next.
6418 Limit is the maximum position up to which to check for property
6419 changes in Fnext_single_property_change. Strings are usually
6420 short, so set the limit to the end of the string. */
6421 XSETFASTINT (limit
, XSTRING (string
)->size
);
6422 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6424 *endptr
= XFASTINT (end
);
6428 base_face
= FACE_FROM_ID (f
, base_face_id
);
6429 xassert (base_face
);
6431 /* Optimize the default case that there is no face property and we
6432 are not in the region. */
6434 && (base_face_id
!= DEFAULT_FACE_ID
6435 /* BUFPOS <= 0 means STRING is not an overlay string, so
6436 that the region doesn't have to be taken into account. */
6438 || bufpos
< region_beg
6439 || bufpos
>= region_end
)
6441 /* We can't realize faces for different charsets differently
6442 if we don't have fonts, so we can stop here if not working
6443 on a window-system frame. */
6444 || !FRAME_WINDOW_P (f
)
6445 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6446 return base_face
->id
;
6448 /* Begin with attributes from the base face. */
6449 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6451 /* Merge in attributes specified via text properties. */
6453 merge_face_vector_with_property (f
, attrs
, prop
);
6455 /* If in the region, merge in the region face. */
6457 && bufpos
>= region_beg
6458 && bufpos
< region_end
)
6460 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6461 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6464 /* Look up a realized face with the given face attributes,
6465 or realize a new one. */
6466 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6471 /***********************************************************************
6473 ***********************************************************************/
6477 /* Print the contents of the realized face FACE to stderr. */
6480 dump_realized_face (face
)
6483 fprintf (stderr
, "ID: %d\n", face
->id
);
6484 #ifdef HAVE_X_WINDOWS
6485 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6487 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6489 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6490 fprintf (stderr
, "background: 0x%lx (%s)\n",
6492 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6493 fprintf (stderr
, "font_name: %s (%s)\n",
6495 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6496 #ifdef HAVE_X_WINDOWS
6497 fprintf (stderr
, "font = %p\n", face
->font
);
6499 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6500 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6501 fprintf (stderr
, "underline: %d (%s)\n",
6503 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6504 fprintf (stderr
, "hash: %d\n", face
->hash
);
6505 fprintf (stderr
, "charset: %d\n", face
->charset
);
6509 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6517 fprintf (stderr
, "font selection order: ");
6518 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6519 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6520 fprintf (stderr
, "\n");
6522 fprintf (stderr
, "alternative fonts: ");
6523 debug_print (Vface_alternative_font_family_alist
);
6524 fprintf (stderr
, "\n");
6526 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6527 Fdump_face (make_number (i
));
6532 CHECK_NUMBER (n
, 0);
6533 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6535 error ("Not a valid face");
6536 dump_realized_face (face
);
6543 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6547 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6548 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6549 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6553 #endif /* GLYPH_DEBUG != 0 */
6557 /***********************************************************************
6559 ***********************************************************************/
6564 Qface
= intern ("face");
6566 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6567 staticpro (&Qbitmap_spec_p
);
6568 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6569 staticpro (&Qframe_update_face_colors
);
6571 /* Lisp face attribute keywords. */
6572 QCfamily
= intern (":family");
6573 staticpro (&QCfamily
);
6574 QCheight
= intern (":height");
6575 staticpro (&QCheight
);
6576 QCweight
= intern (":weight");
6577 staticpro (&QCweight
);
6578 QCslant
= intern (":slant");
6579 staticpro (&QCslant
);
6580 QCunderline
= intern (":underline");
6581 staticpro (&QCunderline
);
6582 QCinverse_video
= intern (":inverse-video");
6583 staticpro (&QCinverse_video
);
6584 QCreverse_video
= intern (":reverse-video");
6585 staticpro (&QCreverse_video
);
6586 QCforeground
= intern (":foreground");
6587 staticpro (&QCforeground
);
6588 QCbackground
= intern (":background");
6589 staticpro (&QCbackground
);
6590 QCstipple
= intern (":stipple");;
6591 staticpro (&QCstipple
);
6592 QCwidth
= intern (":width");
6593 staticpro (&QCwidth
);
6594 QCfont
= intern (":font");
6595 staticpro (&QCfont
);
6596 QCbold
= intern (":bold");
6597 staticpro (&QCbold
);
6598 QCitalic
= intern (":italic");
6599 staticpro (&QCitalic
);
6600 QCoverline
= intern (":overline");
6601 staticpro (&QCoverline
);
6602 QCstrike_through
= intern (":strike-through");
6603 staticpro (&QCstrike_through
);
6604 QCbox
= intern (":box");
6607 /* Symbols used for Lisp face attribute values. */
6608 QCcolor
= intern (":color");
6609 staticpro (&QCcolor
);
6610 QCline_width
= intern (":line-width");
6611 staticpro (&QCline_width
);
6612 QCstyle
= intern (":style");
6613 staticpro (&QCstyle
);
6614 Qreleased_button
= intern ("released-button");
6615 staticpro (&Qreleased_button
);
6616 Qpressed_button
= intern ("pressed-button");
6617 staticpro (&Qpressed_button
);
6618 Qnormal
= intern ("normal");
6619 staticpro (&Qnormal
);
6620 Qultra_light
= intern ("ultra-light");
6621 staticpro (&Qultra_light
);
6622 Qextra_light
= intern ("extra-light");
6623 staticpro (&Qextra_light
);
6624 Qlight
= intern ("light");
6625 staticpro (&Qlight
);
6626 Qsemi_light
= intern ("semi-light");
6627 staticpro (&Qsemi_light
);
6628 Qsemi_bold
= intern ("semi-bold");
6629 staticpro (&Qsemi_bold
);
6630 Qbold
= intern ("bold");
6632 Qextra_bold
= intern ("extra-bold");
6633 staticpro (&Qextra_bold
);
6634 Qultra_bold
= intern ("ultra-bold");
6635 staticpro (&Qultra_bold
);
6636 Qoblique
= intern ("oblique");
6637 staticpro (&Qoblique
);
6638 Qitalic
= intern ("italic");
6639 staticpro (&Qitalic
);
6640 Qreverse_oblique
= intern ("reverse-oblique");
6641 staticpro (&Qreverse_oblique
);
6642 Qreverse_italic
= intern ("reverse-italic");
6643 staticpro (&Qreverse_italic
);
6644 Qultra_condensed
= intern ("ultra-condensed");
6645 staticpro (&Qultra_condensed
);
6646 Qextra_condensed
= intern ("extra-condensed");
6647 staticpro (&Qextra_condensed
);
6648 Qcondensed
= intern ("condensed");
6649 staticpro (&Qcondensed
);
6650 Qsemi_condensed
= intern ("semi-condensed");
6651 staticpro (&Qsemi_condensed
);
6652 Qsemi_expanded
= intern ("semi-expanded");
6653 staticpro (&Qsemi_expanded
);
6654 Qexpanded
= intern ("expanded");
6655 staticpro (&Qexpanded
);
6656 Qextra_expanded
= intern ("extra-expanded");
6657 staticpro (&Qextra_expanded
);
6658 Qultra_expanded
= intern ("ultra-expanded");
6659 staticpro (&Qultra_expanded
);
6660 Qbackground_color
= intern ("background-color");
6661 staticpro (&Qbackground_color
);
6662 Qforeground_color
= intern ("foreground-color");
6663 staticpro (&Qforeground_color
);
6664 Qunspecified
= intern ("unspecified");
6665 staticpro (&Qunspecified
);
6667 Qx_charset_registry
= intern ("x-charset-registry");
6668 staticpro (&Qx_charset_registry
);
6669 Qface_alias
= intern ("face-alias");
6670 staticpro (&Qface_alias
);
6671 Qdefault
= intern ("default");
6672 staticpro (&Qdefault
);
6673 Qtool_bar
= intern ("tool-bar");
6674 staticpro (&Qtool_bar
);
6675 Qregion
= intern ("region");
6676 staticpro (&Qregion
);
6677 Qfringe
= intern ("fringe");
6678 staticpro (&Qfringe
);
6679 Qheader_line
= intern ("header-line");
6680 staticpro (&Qheader_line
);
6681 Qscroll_bar
= intern ("scroll-bar");
6682 staticpro (&Qscroll_bar
);
6683 Qmenu
= intern ("menu");
6685 Qcursor
= intern ("cursor");
6686 staticpro (&Qcursor
);
6687 Qborder
= intern ("border");
6688 staticpro (&Qborder
);
6689 Qmouse
= intern ("mouse");
6690 staticpro (&Qmouse
);
6691 Qtty_color_desc
= intern ("tty-color-desc");
6692 staticpro (&Qtty_color_desc
);
6693 Qtty_color_by_index
= intern ("tty-color-by-index");
6694 staticpro (&Qtty_color_by_index
);
6696 defsubr (&Sinternal_make_lisp_face
);
6697 defsubr (&Sinternal_lisp_face_p
);
6698 defsubr (&Sinternal_set_lisp_face_attribute
);
6699 #ifdef HAVE_X_WINDOWS
6700 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6701 defsubr (&Sface_color_gray_p
);
6702 defsubr (&Sface_color_supported_p
);
6704 defsubr (&Sinternal_get_lisp_face_attribute
);
6705 defsubr (&Sinternal_lisp_face_attribute_values
);
6706 defsubr (&Sinternal_lisp_face_equal_p
);
6707 defsubr (&Sinternal_lisp_face_empty_p
);
6708 defsubr (&Sinternal_copy_lisp_face
);
6709 defsubr (&Sinternal_merge_in_global_face
);
6710 defsubr (&Sface_font
);
6711 defsubr (&Sframe_face_alist
);
6712 defsubr (&Sinternal_set_font_selection_order
);
6713 defsubr (&Sinternal_set_alternative_font_family_alist
);
6715 defsubr (&Sdump_face
);
6716 defsubr (&Sshow_face_resources
);
6717 #endif /* GLYPH_DEBUG */
6718 defsubr (&Sclear_face_cache
);
6720 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6721 "*Limit for font matching.\n\
6722 If an integer > 0, font matching functions won't load more than\n\
6723 that number of fonts when searching for a matching font.");
6724 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6726 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6727 "List of global face definitions (for internal use only.)");
6728 Vface_new_frame_defaults
= Qnil
;
6730 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6731 "*Default stipple pattern used on monochrome displays.\n\
6732 This stipple pattern is used on monochrome displays\n\
6733 instead of shades of gray for a face background color.\n\
6734 See `set-face-stipple' for possible values for this variable.");
6735 Vface_default_stipple
= build_string ("gray3");
6737 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6738 "Default registry and encoding to use.\n\
6739 This registry and encoding is used for unibyte text. It is set up\n\
6740 from the specified frame font when Emacs starts. (For internal use only.)");
6741 Vface_default_registry
= Qnil
;
6743 DEFVAR_LISP ("face-alternative-font-family-alist",
6744 &Vface_alternative_font_family_alist
, "");
6745 Vface_alternative_font_family_alist
= Qnil
;
6749 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6750 "Allowed scalable fonts.\n\
6751 A value of nil means don't allow any scalable fonts.\n\
6752 A value of t means allow any scalable font.\n\
6753 Otherwise, value must be a list of regular expressions. A font may be\n\
6754 scaled if its name matches a regular expression in the list.");
6755 Vscalable_fonts_allowed
= Qnil
;
6757 #endif /* SCALABLE_FONTS */
6759 #ifdef HAVE_X_WINDOWS
6760 defsubr (&Sbitmap_spec_p
);
6761 defsubr (&Sx_list_fonts
);
6762 defsubr (&Sinternal_face_x_get_resource
);
6763 defsubr (&Sx_family_fonts
);
6764 defsubr (&Sx_font_family_list
);
6765 #endif /* HAVE_X_WINDOWS */