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 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
,
1089 red
= 0, green
= 0, blue
= 0;
1092 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1096 XSETFRAME (frame
, f
);
1098 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1099 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1101 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1102 if (CONSP (XCDR (XCDR (color_desc
))))
1104 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1105 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1106 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1110 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1111 /* We were called early during startup, and the colors are not
1112 yet set up in tty-defined-color-alist. Don't return a failure
1113 indication, since this produces the annoying "Unable to
1114 load color" messages in the *Messages* buffer. */
1117 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1119 if (strcmp (color_name
, "unspecified-fg") == 0)
1120 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1121 else if (strcmp (color_name
, "unspecified-bg") == 0)
1122 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1125 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1128 color_def
->pixel
= color_idx
;
1129 color_def
->red
= red
;
1130 color_def
->green
= green
;
1131 color_def
->blue
= blue
;
1136 /* Decide if color named COLOR is valid for the display associated
1137 with the frame F; if so, return the rgb values in COLOR_DEF. If
1138 ALLOC is nonzero, allocate a new colormap cell.
1140 This does the right thing for any type of frame. */
1142 defined_color (f
, color_name
, color_def
, alloc
)
1148 if (!FRAME_WINDOW_P (f
))
1149 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1150 #ifdef HAVE_X_WINDOWS
1151 else if (FRAME_X_P (f
))
1152 return x_defined_color (f
, color_name
, color_def
, alloc
);
1155 else if (FRAME_W32_P (f
))
1156 /* FIXME: w32_defined_color doesn't exist! w32fns.c defines
1157 defined_color which needs to be renamed, and the declaration
1158 of color_def therein should be changed. */
1159 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1162 else if (FRAME_MAC_P (f
))
1163 /* FIXME: mac_defined_color doesn't exist! */
1164 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1170 /* Given the index of the tty color, return its name, a Lisp string. */
1173 tty_color_name (f
, idx
)
1179 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1182 Lisp_Object coldesc
;
1184 XSETFRAME (frame
, f
);
1185 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1187 if (!NILP (coldesc
))
1188 return XCAR (coldesc
);
1191 /* We can have an MSDOG frame under -nw for a short window of
1192 opportunity before internal_terminal_init is called. DTRT. */
1193 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1194 return msdos_stdcolor_name (idx
);
1198 /* FIXME: When/if w32 supports colors in non-window mode, there should
1199 be a call here to a w32-specific function that returns the color
1200 by index using the default color mapping on a Windows console. */
1203 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1204 return build_string (unspecified_fg
);
1205 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1206 return build_string (unspecified_bg
);
1207 return Qunspecified
;
1210 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1211 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1214 face_color_gray_p (f
, color_name
)
1221 if (defined_color (f
, color_name
, &color
, 0))
1222 gray_p
= ((abs (color
.red
- color
.green
)
1223 < max (color
.red
, color
.green
) / 20)
1224 && (abs (color
.green
- color
.blue
)
1225 < max (color
.green
, color
.blue
) / 20)
1226 && (abs (color
.blue
- color
.red
)
1227 < max (color
.blue
, color
.red
) / 20));
1235 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1236 BACKGROUND_P non-zero means the color will be used as background
1240 face_color_supported_p (f
, color_name
, background_p
)
1248 XSETFRAME (frame
, f
);
1249 return (FRAME_WINDOW_P (f
)
1250 ? (!NILP (Fxw_display_color_p (frame
))
1251 || xstricmp (color_name
, "black") == 0
1252 || xstricmp (color_name
, "white") == 0
1254 && face_color_gray_p (f
, color_name
))
1255 || (!NILP (Fx_display_grayscale_p (frame
))
1256 && face_color_gray_p (f
, color_name
)))
1257 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1261 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1262 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1263 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1264 If FRAME is nil or omitted, use the selected frame.")
1266 Lisp_Object color
, frame
;
1270 CHECK_FRAME (frame
, 0);
1271 CHECK_STRING (color
, 0);
1273 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1277 DEFUN ("color-supported-p", Fcolor_supported_p
,
1278 Scolor_supported_p
, 2, 3, 0,
1279 "Return non-nil if COLOR can be displayed on FRAME.\n\
1280 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1281 If FRAME is nil or omitted, use the selected frame.\n\
1282 COLOR must be a valid color name.")
1283 (color
, frame
, background_p
)
1284 Lisp_Object frame
, color
, background_p
;
1288 CHECK_FRAME (frame
, 0);
1289 CHECK_STRING (color
, 0);
1291 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1296 /* Load color with name NAME for use by face FACE on frame F.
1297 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1298 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1299 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1300 pixel color. If color cannot be loaded, display a message, and
1301 return the foreground, background or underline color of F, but
1302 record that fact in flags of the face so that we don't try to free
1306 load_color (f
, face
, name
, target_index
)
1310 enum lface_attribute_index target_index
;
1314 xassert (STRINGP (name
));
1315 xassert (target_index
== LFACE_FOREGROUND_INDEX
1316 || target_index
== LFACE_BACKGROUND_INDEX
1317 || target_index
== LFACE_UNDERLINE_INDEX
1318 || target_index
== LFACE_OVERLINE_INDEX
1319 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1320 || target_index
== LFACE_BOX_INDEX
);
1322 /* if the color map is full, defined_color will return a best match
1323 to the values in an existing cell. */
1324 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1326 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1328 switch (target_index
)
1330 case LFACE_FOREGROUND_INDEX
:
1331 face
->foreground_defaulted_p
= 1;
1332 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1335 case LFACE_BACKGROUND_INDEX
:
1336 face
->background_defaulted_p
= 1;
1337 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1340 case LFACE_UNDERLINE_INDEX
:
1341 face
->underline_defaulted_p
= 1;
1342 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1345 case LFACE_OVERLINE_INDEX
:
1346 face
->overline_color_defaulted_p
= 1;
1347 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1350 case LFACE_STRIKE_THROUGH_INDEX
:
1351 face
->strike_through_color_defaulted_p
= 1;
1352 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1355 case LFACE_BOX_INDEX
:
1356 face
->box_color_defaulted_p
= 1;
1357 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1366 ++ncolors_allocated
;
1372 #ifdef HAVE_X_WINDOWS
1374 /* Load colors for face FACE which is used on frame F. Colors are
1375 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1376 of ATTRS. If the background color specified is not supported on F,
1377 try to emulate gray colors with a stipple from Vface_default_stipple. */
1380 load_face_colors (f
, face
, attrs
)
1387 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1388 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1390 /* Swap colors if face is inverse-video. */
1391 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1399 /* Check for support for foreground, not for background because
1400 face_color_supported_p is smart enough to know that grays are
1401 "supported" as background because we are supposed to use stipple
1403 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1404 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1406 x_destroy_bitmap (f
, face
->stipple
);
1407 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1408 &face
->pixmap_w
, &face
->pixmap_h
);
1411 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1412 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1416 /* Free color PIXEL on frame F. */
1419 unload_color (f
, pixel
)
1421 unsigned long pixel
;
1423 Display
*dpy
= FRAME_X_DISPLAY (f
);
1424 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1426 if (pixel
== BLACK_PIX_DEFAULT (f
)
1427 || pixel
== WHITE_PIX_DEFAULT (f
))
1432 /* If display has an immutable color map, freeing colors is not
1433 necessary and some servers don't allow it. So don't do it. */
1434 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1436 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1437 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1444 /* Free colors allocated for FACE. */
1447 free_face_colors (f
, face
)
1451 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1453 /* If display has an immutable color map, freeing colors is not
1454 necessary and some servers don't allow it. So don't do it. */
1455 if (class != StaticColor
1456 && class != StaticGray
1457 && class != TrueColor
)
1463 dpy
= FRAME_X_DISPLAY (f
);
1464 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1466 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1467 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1468 && !face
->foreground_defaulted_p
)
1470 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1471 IF_DEBUG (--ncolors_allocated
);
1474 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1475 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1476 && !face
->background_defaulted_p
)
1478 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1479 IF_DEBUG (--ncolors_allocated
);
1482 if (face
->underline_p
1483 && !face
->underline_defaulted_p
1484 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1485 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1487 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1488 IF_DEBUG (--ncolors_allocated
);
1491 if (face
->overline_p
1492 && !face
->overline_color_defaulted_p
1493 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1494 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1496 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1497 IF_DEBUG (--ncolors_allocated
);
1500 if (face
->strike_through_p
1501 && !face
->strike_through_color_defaulted_p
1502 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1503 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1505 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1506 IF_DEBUG (--ncolors_allocated
);
1509 if (face
->box
!= FACE_NO_BOX
1510 && !face
->box_color_defaulted_p
1511 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1512 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1514 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1515 IF_DEBUG (--ncolors_allocated
);
1521 #endif /* HAVE_X_WINDOWS */
1525 /***********************************************************************
1527 ***********************************************************************/
1529 /* An enumerator for each field of an XLFD font name. */
1550 /* An enumerator for each possible slant value of a font. Taken from
1551 the XLFD specification. */
1559 XLFD_SLANT_REVERSE_ITALIC
,
1560 XLFD_SLANT_REVERSE_OBLIQUE
,
1564 /* Relative font weight according to XLFD documentation. */
1568 XLFD_WEIGHT_UNKNOWN
,
1569 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1570 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1571 XLFD_WEIGHT_LIGHT
, /* 30 */
1572 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1573 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1574 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1575 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1576 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1577 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1580 /* Relative proportionate width. */
1584 XLFD_SWIDTH_UNKNOWN
,
1585 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1586 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1587 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1588 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1589 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1590 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1591 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1592 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1593 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1596 /* Structure used for tables mapping XLFD weight, slant, and width
1597 names to numeric and symbolic values. */
1603 Lisp_Object
*symbol
;
1606 /* Table of XLFD slant names and their numeric and symbolic
1607 representations. This table must be sorted by slant names in
1610 static struct table_entry slant_table
[] =
1612 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1613 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1614 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1615 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1616 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1617 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1620 /* Table of XLFD weight names. This table must be sorted by weight
1621 names in ascending order. */
1623 static struct table_entry weight_table
[] =
1625 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1626 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1627 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1628 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1629 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1630 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1631 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1632 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1633 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1634 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1635 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1636 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1637 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1638 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1639 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1642 /* Table of XLFD width names. This table must be sorted by width
1643 names in ascending order. */
1645 static struct table_entry swidth_table
[] =
1647 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1648 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1649 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1650 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1651 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1652 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1653 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1654 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1655 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1656 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1657 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1658 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1659 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1660 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1661 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1664 /* Structure used to hold the result of splitting font names in XLFD
1665 format into their fields. */
1669 /* The original name which is modified destructively by
1670 split_font_name. The pointer is kept here to be able to free it
1671 if it was allocated from the heap. */
1674 /* Font name fields. Each vector element points into `name' above.
1675 Fields are NUL-terminated. */
1676 char *fields
[XLFD_LAST
];
1678 /* Numeric values for those fields that interest us. See
1679 split_font_name for which these are. */
1680 int numeric
[XLFD_LAST
];
1683 /* The frame in effect when sorting font names. Set temporarily in
1684 sort_fonts so that it is available in font comparison functions. */
1686 static struct frame
*font_frame
;
1688 /* Order by which font selection chooses fonts. The default values
1689 mean `first, find a best match for the font width, then for the
1690 font height, then for weight, then for slant.' This variable can be
1691 set via set-face-font-sort-order. */
1693 static int font_sort_order
[4];
1696 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1697 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1698 is a pointer to the matching table entry or null if no table entry
1701 static struct table_entry
*
1702 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1703 struct table_entry
*table
;
1705 struct font_name
*font
;
1708 /* Function split_font_name converts fields to lower-case, so there
1709 is no need to use xstrlwr or xstricmp here. */
1710 char *s
= font
->fields
[field_index
];
1711 int low
, mid
, high
, cmp
;
1718 mid
= (low
+ high
) / 2;
1719 cmp
= strcmp (table
[mid
].name
, s
);
1733 /* Return a numeric representation for font name field
1734 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1735 has DIM entries. Value is the numeric value found or DFLT if no
1736 table entry matches. This function is used to translate weight,
1737 slant, and swidth names of XLFD font names to numeric values. */
1740 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1741 struct table_entry
*table
;
1743 struct font_name
*font
;
1747 struct table_entry
*p
;
1748 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1749 return p
? p
->numeric
: dflt
;
1753 /* Return a symbolic representation for font name field
1754 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1755 has DIM entries. Value is the symbolic value found or DFLT if no
1756 table entry matches. This function is used to translate weight,
1757 slant, and swidth names of XLFD font names to symbols. */
1759 static INLINE Lisp_Object
1760 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1761 struct table_entry
*table
;
1763 struct font_name
*font
;
1767 struct table_entry
*p
;
1768 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1769 return p
? *p
->symbol
: dflt
;
1773 /* Return a numeric value for the slant of the font given by FONT. */
1776 xlfd_numeric_slant (font
)
1777 struct font_name
*font
;
1779 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1780 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1784 /* Return a symbol representing the weight of the font given by FONT. */
1786 static INLINE Lisp_Object
1787 xlfd_symbolic_slant (font
)
1788 struct font_name
*font
;
1790 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1791 font
, XLFD_SLANT
, Qnormal
);
1795 /* Return a numeric value for the weight of the font given by FONT. */
1798 xlfd_numeric_weight (font
)
1799 struct font_name
*font
;
1801 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1802 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1806 /* Return a symbol representing the slant of the font given by FONT. */
1808 static INLINE Lisp_Object
1809 xlfd_symbolic_weight (font
)
1810 struct font_name
*font
;
1812 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1813 font
, XLFD_WEIGHT
, Qnormal
);
1817 /* Return a numeric value for the swidth of the font whose XLFD font
1818 name fields are found in FONT. */
1821 xlfd_numeric_swidth (font
)
1822 struct font_name
*font
;
1824 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1825 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1829 /* Return a symbolic value for the swidth of FONT. */
1831 static INLINE Lisp_Object
1832 xlfd_symbolic_swidth (font
)
1833 struct font_name
*font
;
1835 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1836 font
, XLFD_SWIDTH
, Qnormal
);
1840 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1841 entries. Value is a pointer to the matching table entry or null if
1842 no element of TABLE contains SYMBOL. */
1844 static struct table_entry
*
1845 face_value (table
, dim
, symbol
)
1846 struct table_entry
*table
;
1852 xassert (SYMBOLP (symbol
));
1854 for (i
= 0; i
< dim
; ++i
)
1855 if (EQ (*table
[i
].symbol
, symbol
))
1858 return i
< dim
? table
+ i
: NULL
;
1862 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1863 entries. Value is -1 if SYMBOL is not found in TABLE. */
1866 face_numeric_value (table
, dim
, symbol
)
1867 struct table_entry
*table
;
1871 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1872 return p
? p
->numeric
: -1;
1876 /* Return a numeric value representing the weight specified by Lisp
1877 symbol WEIGHT. Value is one of the enumerators of enum
1881 face_numeric_weight (weight
)
1884 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1888 /* Return a numeric value representing the slant specified by Lisp
1889 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1892 face_numeric_slant (slant
)
1895 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1899 /* Return a numeric value representing the swidth specified by Lisp
1900 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1903 face_numeric_swidth (width
)
1906 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1910 #ifdef HAVE_X_WINDOWS
1912 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1916 struct font_name
*font
;
1918 /* Function split_font_name converts fields to lower-case, so there
1919 is no need to use tolower here. */
1920 return *font
->fields
[XLFD_SPACING
] != 'p';
1924 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1926 The actual height of the font when displayed on F depends on the
1927 resolution of both the font and frame. For example, a 10pt font
1928 designed for a 100dpi display will display larger than 10pt on a
1929 75dpi display. (It's not unusual to use fonts not designed for the
1930 display one is using. For example, some intlfonts are available in
1931 72dpi versions, only.)
1933 Value is the real point size of FONT on frame F, or 0 if it cannot
1937 xlfd_point_size (f
, font
)
1939 struct font_name
*font
;
1941 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1942 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1943 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1946 if (font_resy
== 0 || font_pt
== 0)
1949 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1955 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1956 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1957 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1958 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1959 zero if the font name doesn't have the format we expect. The
1960 expected format is a font name that starts with a `-' and has
1961 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1962 forms of font names where certain field contents are enclosed in
1963 square brackets. We don't support that, for now. */
1966 split_font_name (f
, font
, numeric_p
)
1968 struct font_name
*font
;
1974 if (*font
->name
== '-')
1976 char *p
= xstrlwr (font
->name
) + 1;
1978 while (i
< XLFD_LAST
)
1980 font
->fields
[i
] = p
;
1983 while (*p
&& *p
!= '-')
1993 success_p
= i
== XLFD_LAST
;
1995 /* If requested, and font name was in the expected format,
1996 compute numeric values for some fields. */
1997 if (numeric_p
&& success_p
)
1999 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2000 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2001 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2002 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2003 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2010 /* Build an XLFD font name from font name fields in FONT. Value is a
2011 pointer to the font name, which is allocated via xmalloc. */
2014 build_font_name (font
)
2015 struct font_name
*font
;
2019 char *font_name
= (char *) xmalloc (size
);
2020 int total_length
= 0;
2022 for (i
= 0; i
< XLFD_LAST
; ++i
)
2024 /* Add 1 because of the leading `-'. */
2025 int len
= strlen (font
->fields
[i
]) + 1;
2027 /* Reallocate font_name if necessary. Add 1 for the final
2029 if (total_length
+ len
+ 1 >= size
)
2031 int new_size
= max (2 * size
, size
+ len
+ 1);
2032 int sz
= new_size
* sizeof *font_name
;
2033 font_name
= (char *) xrealloc (font_name
, sz
);
2037 font_name
[total_length
] = '-';
2038 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2039 total_length
+= len
;
2042 font_name
[total_length
] = 0;
2047 /* Free an array FONTS of N font_name structures. This frees FONTS
2048 itself and all `name' fields in its elements. */
2051 free_font_names (fonts
, n
)
2052 struct font_name
*fonts
;
2056 xfree (fonts
[--n
].name
);
2061 /* Sort vector FONTS of font_name structures which contains NFONTS
2062 elements using qsort and comparison function CMPFN. F is the frame
2063 on which the fonts will be used. The global variable font_frame
2064 is temporarily set to F to make it available in CMPFN. */
2067 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2069 struct font_name
*fonts
;
2071 int (*cmpfn
) P_ ((const void *, const void *));
2074 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2079 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2080 display in x_display_list. FONTS is a pointer to a vector of
2081 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2082 alternative patterns from Valternate_fontname_alist if no fonts are
2083 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2086 For all fonts found, set FONTS[i].name to the name of the font,
2087 allocated via xmalloc, and split font names into fields. Ignore
2088 fonts that we can't parse. Value is the number of fonts found.
2090 This is similar to x_list_fonts. The differences are:
2092 1. It avoids consing.
2093 2. It never calls XLoadQueryFont. */
2096 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2100 struct font_name
*fonts
;
2101 int nfonts
, try_alternatives_p
;
2102 int scalable_fonts_p
;
2104 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2108 /* Get the list of fonts matching PATTERN from the X server. */
2110 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2115 /* Make a copy of the font names we got from X, and
2116 split them into fields. */
2117 for (i
= j
= 0; i
< n
; ++i
)
2119 /* Make a copy of the font name. */
2120 fonts
[j
].name
= xstrdup (names
[i
]);
2122 /* Ignore fonts having a name that we can't parse. */
2123 if (!split_font_name (f
, fonts
+ j
, 1))
2124 xfree (fonts
[j
].name
);
2125 else if (font_scalable_p (fonts
+ j
))
2128 if (!scalable_fonts_p
2129 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2130 xfree (fonts
[j
].name
);
2133 #else /* !SCALABLE_FONTS */
2134 /* Always ignore scalable fonts. */
2135 xfree (fonts
[j
].name
);
2136 #endif /* !SCALABLE_FONTS */
2144 /* Free font names. */
2146 XFreeFontNames (names
);
2151 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2152 if (n
== 0 && try_alternatives_p
)
2154 Lisp_Object list
= Valternate_fontname_alist
;
2156 while (CONSP (list
))
2158 Lisp_Object entry
= XCAR (list
);
2160 && STRINGP (XCAR (entry
))
2161 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2168 Lisp_Object patterns
= XCAR (list
);
2171 while (CONSP (patterns
)
2172 /* If list is screwed up, give up. */
2173 && (name
= XCAR (patterns
),
2175 /* Ignore patterns equal to PATTERN because we tried that
2176 already with no success. */
2177 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2178 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2182 patterns
= XCDR (patterns
);
2190 /* Determine the first font matching PATTERN on frame F. Return in
2191 *FONT the matching font name, split into fields. Value is non-zero
2192 if a match was found. */
2195 first_font_matching (f
, pattern
, font
)
2198 struct font_name
*font
;
2201 struct font_name
*fonts
;
2203 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2204 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2208 bcopy (&fonts
[0], font
, sizeof *font
);
2210 fonts
[0].name
= NULL
;
2211 free_font_names (fonts
, nfonts
);
2218 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2219 using comparison function CMPFN. Value is the number of fonts
2220 found. If value is non-zero, *FONTS is set to a vector of
2221 font_name structures allocated from the heap containing matching
2222 fonts. Each element of *FONTS contains a name member that is also
2223 allocated from the heap. Font names in these structures are split
2224 into fields. Use free_font_names to free such an array. */
2227 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2230 int (*cmpfn
) P_ ((const void *, const void *));
2231 struct font_name
**fonts
;
2235 /* Get the list of fonts matching pattern. 100 should suffice. */
2236 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2237 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2238 nfonts
= XFASTINT (Vfont_list_limit
);
2240 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2242 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2244 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2247 /* Sort the resulting array and return it in *FONTS. If no
2248 fonts were found, make sure to set *FONTS to null. */
2250 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2261 /* Compare two font_name structures *A and *B. Value is analogous to
2262 strcmp. Sort order is given by the global variable
2263 font_sort_order. Font names are sorted so that, everything else
2264 being equal, fonts with a resolution closer to that of the frame on
2265 which they are used are listed first. The global variable
2266 font_frame is the frame on which we operate. */
2269 cmp_font_names (a
, b
)
2272 struct font_name
*x
= (struct font_name
*) a
;
2273 struct font_name
*y
= (struct font_name
*) b
;
2276 /* All strings have been converted to lower-case by split_font_name,
2277 so we can use strcmp here. */
2278 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2283 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2285 int j
= font_sort_order
[i
];
2286 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2291 /* Everything else being equal, we prefer fonts with an
2292 y-resolution closer to that of the frame. */
2293 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2294 int x_resy
= x
->numeric
[XLFD_RESY
];
2295 int y_resy
= y
->numeric
[XLFD_RESY
];
2296 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2304 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2305 is non-null list fonts matching that pattern. Otherwise, if
2306 REGISTRY_AND_ENCODING is non-null return only fonts with that
2307 registry and encoding, otherwise return fonts of any registry and
2308 encoding. Set *FONTS to a vector of font_name structures allocated
2309 from the heap containing the fonts found. Value is the number of
2313 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2317 char *registry_and_encoding
;
2318 struct font_name
**fonts
;
2320 if (pattern
== NULL
)
2325 if (registry_and_encoding
== NULL
)
2326 registry_and_encoding
= "*";
2328 pattern
= (char *) alloca (strlen (family
)
2329 + strlen (registry_and_encoding
)
2331 if (index (family
, '-'))
2332 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2334 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2337 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2341 /* Remove elements from LIST whose cars are `equal'. Called from
2342 x-family-fonts and x-font-family-list to remove duplicate font
2346 remove_duplicates (list
)
2349 Lisp_Object tail
= list
;
2351 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2353 Lisp_Object next
= XCDR (tail
);
2354 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2355 XCDR (tail
) = XCDR (next
);
2362 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2363 "Return a list of available fonts of family FAMILY on FRAME.\n\
2364 If FAMILY is omitted or nil, list all families.\n\
2365 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2367 If FRAME is omitted or nil, use the selected frame.\n\
2368 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2369 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2370 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2371 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2372 width, weight and slant of the font. These symbols are the same as for\n\
2373 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2374 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2375 giving the registry and encoding of the font.\n\
2376 The result list is sorted according to the current setting of\n\
2377 the face font sort order.")
2379 Lisp_Object family
, frame
;
2381 struct frame
*f
= check_x_frame (frame
);
2382 struct font_name
*fonts
;
2385 struct gcpro gcpro1
;
2386 char *family_pattern
;
2389 family_pattern
= "*";
2392 CHECK_STRING (family
, 1);
2393 family_pattern
= LSTRDUPA (family
);
2398 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2399 for (i
= nfonts
- 1; i
>= 0; --i
)
2401 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2404 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2406 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2407 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2408 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2409 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2410 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2411 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2412 tem
= build_font_name (fonts
+ i
);
2413 ASET (v
, 6, build_string (tem
));
2414 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2415 fonts
[i
].fields
[XLFD_ENCODING
]);
2416 ASET (v
, 7, build_string (tem
));
2419 result
= Fcons (v
, result
);
2424 remove_duplicates (result
);
2425 free_font_names (fonts
, nfonts
);
2431 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2433 "Return a list of available font families on FRAME.\n\
2434 If FRAME is omitted or nil, use the selected frame.\n\
2435 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2436 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2441 struct frame
*f
= check_x_frame (frame
);
2443 struct font_name
*fonts
;
2445 struct gcpro gcpro1
;
2446 int count
= specpdl_ptr
- specpdl
;
2449 /* Let's consider all fonts. Increase the limit for matching
2450 fonts until we have them all. */
2453 specbind (intern ("font-list-limit"), make_number (limit
));
2454 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2456 if (nfonts
== limit
)
2458 free_font_names (fonts
, nfonts
);
2467 for (i
= nfonts
- 1; i
>= 0; --i
)
2468 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2469 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2472 remove_duplicates (result
);
2473 free_font_names (fonts
, nfonts
);
2475 return unbind_to (count
, result
);
2479 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2480 "Return a list of the names of available fonts matching PATTERN.\n\
2481 If optional arguments FACE and FRAME are specified, return only fonts\n\
2482 the same size as FACE on FRAME.\n\
2483 PATTERN is a string, perhaps with wildcard characters;\n\
2484 the * character matches any substring, and\n\
2485 the ? character matches any single character.\n\
2486 PATTERN is case-insensitive.\n\
2487 FACE is a face name--a symbol.\n\
2489 The return value is a list of strings, suitable as arguments to\n\
2492 Fonts Emacs can't use may or may not be excluded\n\
2493 even if they match PATTERN and FACE.\n\
2494 The optional fourth argument MAXIMUM sets a limit on how many\n\
2495 fonts to match. The first MAXIMUM fonts are reported.\n\
2496 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2497 occupied by a character of a font. In that case, return only fonts\n\
2498 the WIDTH times as wide as FACE on FRAME.")
2499 (pattern
, face
, frame
, maximum
, width
)
2500 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2507 CHECK_STRING (pattern
, 0);
2513 CHECK_NATNUM (maximum
, 0);
2514 maxnames
= XINT (maximum
);
2518 CHECK_NUMBER (width
, 4);
2520 /* We can't simply call check_x_frame because this function may be
2521 called before any frame is created. */
2522 f
= frame_or_selected_frame (frame
, 2);
2525 /* Perhaps we have not yet created any frame. */
2530 /* Determine the width standard for comparison with the fonts we find. */
2536 /* This is of limited utility since it works with character
2537 widths. Keep it for compatibility. --gerd. */
2538 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2539 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2542 size
= face
->font
->max_bounds
.width
;
2544 size
= FRAME_FONT (f
)->max_bounds
.width
;
2547 size
*= XINT (width
);
2551 Lisp_Object args
[2];
2553 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2555 /* We don't have to check fontsets. */
2557 args
[1] = list_fontsets (f
, pattern
, size
);
2558 return Fnconc (2, args
);
2562 #endif /* HAVE_X_WINDOWS */
2566 /***********************************************************************
2568 ***********************************************************************/
2570 /* Access face attributes of face FACE, a Lisp vector. */
2572 #define LFACE_FAMILY(LFACE) \
2573 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2574 #define LFACE_HEIGHT(LFACE) \
2575 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2576 #define LFACE_WEIGHT(LFACE) \
2577 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2578 #define LFACE_SLANT(LFACE) \
2579 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2580 #define LFACE_UNDERLINE(LFACE) \
2581 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2582 #define LFACE_INVERSE(LFACE) \
2583 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2584 #define LFACE_FOREGROUND(LFACE) \
2585 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2586 #define LFACE_BACKGROUND(LFACE) \
2587 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2588 #define LFACE_STIPPLE(LFACE) \
2589 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2590 #define LFACE_SWIDTH(LFACE) \
2591 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2592 #define LFACE_OVERLINE(LFACE) \
2593 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2594 #define LFACE_STRIKE_THROUGH(LFACE) \
2595 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2596 #define LFACE_BOX(LFACE) \
2597 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2599 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2600 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2602 #define LFACEP(LFACE) \
2604 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2605 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2610 /* Check consistency of Lisp face attribute vector ATTRS. */
2613 check_lface_attrs (attrs
)
2616 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2617 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2618 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2619 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2620 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2621 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2622 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2623 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2624 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2625 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2626 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2627 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2628 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2629 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2630 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2631 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2632 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2633 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2634 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2635 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2636 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2637 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2638 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2639 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2640 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2641 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2642 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2643 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2644 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2645 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2646 #ifdef HAVE_WINDOW_SYSTEM
2647 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2648 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2649 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2654 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2662 xassert (LFACEP (lface
));
2663 check_lface_attrs (XVECTOR (lface
)->contents
);
2667 #else /* GLYPH_DEBUG == 0 */
2669 #define check_lface_attrs(attrs) (void) 0
2670 #define check_lface(lface) (void) 0
2672 #endif /* GLYPH_DEBUG == 0 */
2675 /* Resolve face name FACE_NAME. If FACE_NAME Is a string, intern it
2676 to make it a symvol. If FACE_NAME is an alias for another face,
2677 return that face's name. */
2680 resolve_face_name (face_name
)
2681 Lisp_Object face_name
;
2683 Lisp_Object aliased
;
2685 if (STRINGP (face_name
))
2686 face_name
= intern (XSTRING (face_name
)->data
);
2690 aliased
= Fget (face_name
, Qface_alias
);
2694 face_name
= aliased
;
2701 /* Return the face definition of FACE_NAME on frame F. F null means
2702 return the global definition. FACE_NAME may be a string or a
2703 symbol (apparently Emacs 20.2 allows strings as face names in face
2704 text properties; ediff uses that). If FACE_NAME is an alias for
2705 another face, return that face's definition. If SIGNAL_P is
2706 non-zero, signal an error if FACE_NAME is not a valid face name.
2707 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2710 static INLINE Lisp_Object
2711 lface_from_face_name (f
, face_name
, signal_p
)
2713 Lisp_Object face_name
;
2718 face_name
= resolve_face_name (face_name
);
2721 lface
= assq_no_quit (face_name
, f
->face_alist
);
2723 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2726 lface
= XCDR (lface
);
2728 signal_error ("Invalid face", face_name
);
2730 check_lface (lface
);
2735 /* Get face attributes of face FACE_NAME from frame-local faces on
2736 frame F. Store the resulting attributes in ATTRS which must point
2737 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2738 is non-zero, signal an error if FACE_NAME does not name a face.
2739 Otherwise, value is zero if FACE_NAME is not a face. */
2742 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2744 Lisp_Object face_name
;
2751 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2754 bcopy (XVECTOR (lface
)->contents
, attrs
,
2755 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2765 /* Non-zero if all attributes in face attribute vector ATTRS are
2766 specified, i.e. are non-nil. */
2769 lface_fully_specified_p (attrs
)
2774 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2775 if (UNSPECIFIEDP (attrs
[i
]))
2778 return i
== LFACE_VECTOR_SIZE
;
2782 #ifdef HAVE_X_WINDOWS
2784 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2785 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2786 LFACE. MAY_FAIL_P non-zero means return 0 if FONT_NAME isn't a
2787 valid font name; otherwise this function tries to use a reasonable
2790 Ignore fields of FONT_NAME containing wildcards. Value is zero if
2791 not successful because FONT_NAME was not in a valid format and
2792 MAY_FAIL_P was non-zero. A valid format is one that is suitable
2793 for split_font_name, see the comment there. */
2796 set_lface_from_font_name (f
, lface
, font_name
, force_p
, may_fail_p
)
2800 int force_p
, may_fail_p
;
2802 struct font_name font
;
2805 int free_font_name_p
= 0;
2806 int have_font_p
= 0;
2808 /* If FONT_NAME contains wildcards, use the first matching font. */
2809 if (index (font_name
, '*') || index (font_name
, '?'))
2811 if (first_font_matching (f
, font_name
, &font
))
2812 free_font_name_p
= have_font_p
= 1;
2816 font
.name
= STRDUPA (font_name
);
2817 if (split_font_name (f
, &font
, 1))
2821 /* The font name may be something like `6x13'. Make
2822 sure we use the full name. */
2823 struct font_info
*font_info
;
2826 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2827 CHARSET_ASCII
, font_name
, -1);
2830 font
.name
= STRDUPA (font_info
->full_name
);
2831 split_font_name (f
, &font
, 1);
2838 /* If FONT_NAME is completely bogus try to use something reasonable
2839 if this function must succeed. Otherwise, give up. */
2844 else if (first_font_matching (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
2846 || first_font_matching (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2848 || first_font_matching (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2850 || first_font_matching (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
2852 || first_font_matching (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
2854 || first_font_matching (f
, "fixed", &font
))
2855 free_font_name_p
= 1;
2861 /* Set attributes only if unspecified, otherwise face defaults for
2862 new frames would never take effect. */
2864 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2866 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2867 + strlen (font
.fields
[XLFD_FOUNDRY
])
2869 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2870 font
.fields
[XLFD_FAMILY
]);
2871 LFACE_FAMILY (lface
) = build_string (buffer
);
2874 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2876 pt
= xlfd_point_size (f
, &font
);
2878 LFACE_HEIGHT (lface
) = make_number (pt
);
2881 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2882 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2884 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2885 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2887 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2888 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2890 if (free_font_name_p
)
2896 #endif /* HAVE_X_WINDOWS */
2899 /* Merge two Lisp face attribute vectors FROM and TO and store the
2900 resulting attributes in TO. Every non-nil attribute of FROM
2901 overrides the corresponding attribute of TO. */
2904 merge_face_vectors (from
, to
)
2905 Lisp_Object
*from
, *to
;
2908 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2909 if (!UNSPECIFIEDP (from
[i
]))
2914 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2915 is a face property, determine the resulting face attributes on
2916 frame F, and store them in TO. PROP may be a single face
2917 specification or a list of such specifications. Each face
2918 specification can be
2920 1. A symbol or string naming a Lisp face.
2922 2. A property list of the form (KEYWORD VALUE ...) where each
2923 KEYWORD is a face attribute name, and value is an appropriate value
2926 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2927 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2928 for compatibility with 20.2.
2930 Face specifications earlier in lists take precedence over later
2934 merge_face_vector_with_property (f
, to
, prop
)
2941 Lisp_Object first
= XCAR (prop
);
2943 if (EQ (first
, Qforeground_color
)
2944 || EQ (first
, Qbackground_color
))
2946 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2947 . COLOR). COLOR must be a string. */
2948 Lisp_Object color_name
= XCDR (prop
);
2949 Lisp_Object color
= first
;
2951 if (STRINGP (color_name
))
2953 if (EQ (color
, Qforeground_color
))
2954 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2956 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2959 add_to_log ("Invalid face color", color_name
, Qnil
);
2961 else if (SYMBOLP (first
)
2962 && *XSYMBOL (first
)->name
->data
== ':')
2964 /* Assume this is the property list form. */
2965 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2967 Lisp_Object keyword
= XCAR (prop
);
2968 Lisp_Object value
= XCAR (XCDR (prop
));
2970 if (EQ (keyword
, QCfamily
))
2972 if (STRINGP (value
))
2973 to
[LFACE_FAMILY_INDEX
] = value
;
2975 add_to_log ("Illegal face font family", value
, Qnil
);
2977 else if (EQ (keyword
, QCheight
))
2979 if (INTEGERP (value
))
2980 to
[LFACE_HEIGHT_INDEX
] = value
;
2982 add_to_log ("Illegal face font height", value
, Qnil
);
2984 else if (EQ (keyword
, QCweight
))
2987 && face_numeric_weight (value
) >= 0)
2988 to
[LFACE_WEIGHT_INDEX
] = value
;
2990 add_to_log ("Illegal face weight", value
, Qnil
);
2992 else if (EQ (keyword
, QCslant
))
2995 && face_numeric_slant (value
) >= 0)
2996 to
[LFACE_SLANT_INDEX
] = value
;
2998 add_to_log ("Illegal face slant", value
, Qnil
);
3000 else if (EQ (keyword
, QCunderline
))
3005 to
[LFACE_UNDERLINE_INDEX
] = value
;
3007 add_to_log ("Illegal face underline", value
, Qnil
);
3009 else if (EQ (keyword
, QCoverline
))
3014 to
[LFACE_OVERLINE_INDEX
] = value
;
3016 add_to_log ("Illegal face overline", value
, Qnil
);
3018 else if (EQ (keyword
, QCstrike_through
))
3023 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3025 add_to_log ("Illegal face strike-through", value
, Qnil
);
3027 else if (EQ (keyword
, QCbox
))
3030 value
= make_number (1);
3031 if (INTEGERP (value
)
3035 to
[LFACE_BOX_INDEX
] = value
;
3037 add_to_log ("Illegal face box", value
, Qnil
);
3039 else if (EQ (keyword
, QCinverse_video
)
3040 || EQ (keyword
, QCreverse_video
))
3042 if (EQ (value
, Qt
) || NILP (value
))
3043 to
[LFACE_INVERSE_INDEX
] = value
;
3045 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3047 else if (EQ (keyword
, QCforeground
))
3049 if (STRINGP (value
))
3050 to
[LFACE_FOREGROUND_INDEX
] = value
;
3052 add_to_log ("Illegal face foreground", value
, Qnil
);
3054 else if (EQ (keyword
, QCbackground
))
3056 if (STRINGP (value
))
3057 to
[LFACE_BACKGROUND_INDEX
] = value
;
3059 add_to_log ("Illegal face background", value
, Qnil
);
3061 else if (EQ (keyword
, QCstipple
))
3063 #ifdef HAVE_X_WINDOWS
3064 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3065 if (!NILP (pixmap_p
))
3066 to
[LFACE_STIPPLE_INDEX
] = value
;
3068 add_to_log ("Illegal face stipple", value
, Qnil
);
3071 else if (EQ (keyword
, QCwidth
))
3074 && face_numeric_swidth (value
) >= 0)
3075 to
[LFACE_SWIDTH_INDEX
] = value
;
3077 add_to_log ("Illegal face width", value
, Qnil
);
3080 add_to_log ("Invalid attribute %s in face property",
3083 prop
= XCDR (XCDR (prop
));
3088 /* This is a list of face specs. Specifications at the
3089 beginning of the list take precedence over later
3090 specifications, so we have to merge starting with the
3091 last specification. */
3092 Lisp_Object next
= XCDR (prop
);
3094 merge_face_vector_with_property (f
, to
, next
);
3095 merge_face_vector_with_property (f
, to
, first
);
3100 /* PROP ought to be a face name. */
3101 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3103 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3105 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3110 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3111 Sinternal_make_lisp_face
, 1, 2, 0,
3112 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3113 If FACE was not known as a face before, create a new one.\n\
3114 If optional argument FRAME is specified, make a frame-local face\n\
3115 for that frame. Otherwise operate on the global face definition.\n\
3116 Value is a vector of face attributes.")
3118 Lisp_Object face
, frame
;
3120 Lisp_Object global_lface
, lface
;
3124 CHECK_SYMBOL (face
, 0);
3125 global_lface
= lface_from_face_name (NULL
, face
, 0);
3129 CHECK_LIVE_FRAME (frame
, 1);
3131 lface
= lface_from_face_name (f
, face
, 0);
3134 f
= NULL
, lface
= Qnil
;
3136 /* Add a global definition if there is none. */
3137 if (NILP (global_lface
))
3139 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3141 XVECTOR (global_lface
)->contents
[0] = Qface
;
3142 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3143 Vface_new_frame_defaults
);
3145 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3146 face id to Lisp face is given by the vector lface_id_to_name.
3147 The mapping from Lisp face to Lisp face id is given by the
3148 property `face' of the Lisp face name. */
3149 if (next_lface_id
== lface_id_to_name_size
)
3151 int new_size
= max (50, 2 * lface_id_to_name_size
);
3152 int sz
= new_size
* sizeof *lface_id_to_name
;
3153 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3154 lface_id_to_name_size
= new_size
;
3157 lface_id_to_name
[next_lface_id
] = face
;
3158 Fput (face
, Qface
, make_number (next_lface_id
));
3162 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3163 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3165 /* Add a frame-local definition. */
3170 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3172 XVECTOR (lface
)->contents
[0] = Qface
;
3173 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3176 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3177 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3180 lface
= global_lface
;
3182 xassert (LFACEP (lface
));
3183 check_lface (lface
);
3188 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3189 Sinternal_lisp_face_p
, 1, 2, 0,
3190 "Return non-nil if FACE names a face.\n\
3191 If optional second parameter FRAME is non-nil, check for the\n\
3192 existence of a frame-local face with name FACE on that frame.\n\
3193 Otherwise check for the existence of a global face.")
3195 Lisp_Object face
, frame
;
3201 CHECK_LIVE_FRAME (frame
, 1);
3202 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3205 lface
= lface_from_face_name (NULL
, face
, 0);
3211 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3212 Sinternal_copy_lisp_face
, 4, 4, 0,
3213 "Copy face FROM to TO.\n\
3214 If FRAME it t, copy the global face definition of FROM to the\n\
3215 global face definition of TO. Otherwise, copy the frame-local\n\
3216 definition of FROM on FRAME to the frame-local definition of TO\n\
3217 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3220 (from
, to
, frame
, new_frame
)
3221 Lisp_Object from
, to
, frame
, new_frame
;
3223 Lisp_Object lface
, copy
;
3225 CHECK_SYMBOL (from
, 0);
3226 CHECK_SYMBOL (to
, 1);
3227 if (NILP (new_frame
))
3232 /* Copy global definition of FROM. We don't make copies of
3233 strings etc. because 20.2 didn't do it either. */
3234 lface
= lface_from_face_name (NULL
, from
, 1);
3235 copy
= Finternal_make_lisp_face (to
, Qnil
);
3239 /* Copy frame-local definition of FROM. */
3240 CHECK_LIVE_FRAME (frame
, 2);
3241 CHECK_LIVE_FRAME (new_frame
, 3);
3242 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3243 copy
= Finternal_make_lisp_face (to
, new_frame
);
3246 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3247 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3253 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3254 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3255 "Set attribute ATTR of FACE to VALUE.\n\
3256 If optional argument FRAME is given, set the face attribute of face FACE\n\
3257 on that frame. If FRAME is t, set the attribute of the default for face\n\
3258 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3260 (face
, attr
, value
, frame
)
3261 Lisp_Object face
, attr
, value
, frame
;
3264 Lisp_Object old_value
= Qnil
;
3265 int font_related_attr_p
= 0;
3267 CHECK_SYMBOL (face
, 0);
3268 CHECK_SYMBOL (attr
, 1);
3270 face
= resolve_face_name (face
);
3272 /* Set lface to the Lisp attribute vector of FACE. */
3274 lface
= lface_from_face_name (NULL
, face
, 1);
3278 frame
= selected_frame
;
3280 CHECK_LIVE_FRAME (frame
, 3);
3281 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3283 /* If a frame-local face doesn't exist yet, create one. */
3285 lface
= Finternal_make_lisp_face (face
, frame
);
3288 if (EQ (attr
, QCfamily
))
3290 if (!UNSPECIFIEDP (value
))
3292 CHECK_STRING (value
, 3);
3293 if (XSTRING (value
)->size
== 0)
3294 signal_error ("Invalid face family", value
);
3296 old_value
= LFACE_FAMILY (lface
);
3297 LFACE_FAMILY (lface
) = value
;
3298 font_related_attr_p
= 1;
3300 else if (EQ (attr
, QCheight
))
3302 if (!UNSPECIFIEDP (value
))
3304 CHECK_NUMBER (value
, 3);
3305 if (XINT (value
) <= 0)
3306 signal_error ("Invalid face height", value
);
3308 old_value
= LFACE_HEIGHT (lface
);
3309 LFACE_HEIGHT (lface
) = value
;
3310 font_related_attr_p
= 1;
3312 else if (EQ (attr
, QCweight
))
3314 if (!UNSPECIFIEDP (value
))
3316 CHECK_SYMBOL (value
, 3);
3317 if (face_numeric_weight (value
) < 0)
3318 signal_error ("Invalid face weight", value
);
3320 old_value
= LFACE_WEIGHT (lface
);
3321 LFACE_WEIGHT (lface
) = value
;
3322 font_related_attr_p
= 1;
3324 else if (EQ (attr
, QCslant
))
3326 if (!UNSPECIFIEDP (value
))
3328 CHECK_SYMBOL (value
, 3);
3329 if (face_numeric_slant (value
) < 0)
3330 signal_error ("Invalid face slant", value
);
3332 old_value
= LFACE_SLANT (lface
);
3333 LFACE_SLANT (lface
) = value
;
3334 font_related_attr_p
= 1;
3336 else if (EQ (attr
, QCunderline
))
3338 if (!UNSPECIFIEDP (value
))
3339 if ((SYMBOLP (value
)
3341 && !EQ (value
, Qnil
))
3342 /* Underline color. */
3344 && XSTRING (value
)->size
== 0))
3345 signal_error ("Invalid face underline", value
);
3347 old_value
= LFACE_UNDERLINE (lface
);
3348 LFACE_UNDERLINE (lface
) = value
;
3350 else if (EQ (attr
, QCoverline
))
3352 if (!UNSPECIFIEDP (value
))
3353 if ((SYMBOLP (value
)
3355 && !EQ (value
, Qnil
))
3356 /* Overline color. */
3358 && XSTRING (value
)->size
== 0))
3359 signal_error ("Invalid face overline", value
);
3361 old_value
= LFACE_OVERLINE (lface
);
3362 LFACE_OVERLINE (lface
) = value
;
3364 else if (EQ (attr
, QCstrike_through
))
3366 if (!UNSPECIFIEDP (value
))
3367 if ((SYMBOLP (value
)
3369 && !EQ (value
, Qnil
))
3370 /* Strike-through color. */
3372 && XSTRING (value
)->size
== 0))
3373 signal_error ("Invalid face strike-through", value
);
3375 old_value
= LFACE_STRIKE_THROUGH (lface
);
3376 LFACE_STRIKE_THROUGH (lface
) = value
;
3378 else if (EQ (attr
, QCbox
))
3382 /* Allow t meaning a simple box of width 1 in foreground color
3385 value
= make_number (1);
3387 if (UNSPECIFIEDP (value
))
3389 else if (NILP (value
))
3391 else if (INTEGERP (value
))
3392 valid_p
= XINT (value
) > 0;
3393 else if (STRINGP (value
))
3394 valid_p
= XSTRING (value
)->size
> 0;
3395 else if (CONSP (value
))
3411 if (EQ (k
, QCline_width
))
3413 if (!INTEGERP (v
) || XINT (v
) <= 0)
3416 else if (EQ (k
, QCcolor
))
3418 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3421 else if (EQ (k
, QCstyle
))
3423 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3430 valid_p
= NILP (tem
);
3436 signal_error ("Invalid face box", value
);
3438 old_value
= LFACE_BOX (lface
);
3439 LFACE_BOX (lface
) = value
;
3441 else if (EQ (attr
, QCinverse_video
)
3442 || EQ (attr
, QCreverse_video
))
3444 if (!UNSPECIFIEDP (value
))
3446 CHECK_SYMBOL (value
, 3);
3447 if (!EQ (value
, Qt
) && !NILP (value
))
3448 signal_error ("Invalid inverse-video face attribute value", value
);
3450 old_value
= LFACE_INVERSE (lface
);
3451 LFACE_INVERSE (lface
) = value
;
3453 else if (EQ (attr
, QCforeground
))
3455 if (!UNSPECIFIEDP (value
))
3457 /* Don't check for valid color names here because it depends
3458 on the frame (display) whether the color will be valid
3459 when the face is realized. */
3460 CHECK_STRING (value
, 3);
3461 if (XSTRING (value
)->size
== 0)
3462 signal_error ("Empty foreground color value", value
);
3464 old_value
= LFACE_FOREGROUND (lface
);
3465 LFACE_FOREGROUND (lface
) = value
;
3467 else if (EQ (attr
, QCbackground
))
3469 if (!UNSPECIFIEDP (value
))
3471 /* Don't check for valid color names here because it depends
3472 on the frame (display) whether the color will be valid
3473 when the face is realized. */
3474 CHECK_STRING (value
, 3);
3475 if (XSTRING (value
)->size
== 0)
3476 signal_error ("Empty background color value", value
);
3478 old_value
= LFACE_BACKGROUND (lface
);
3479 LFACE_BACKGROUND (lface
) = value
;
3481 else if (EQ (attr
, QCstipple
))
3483 #ifdef HAVE_X_WINDOWS
3484 if (!UNSPECIFIEDP (value
)
3486 && NILP (Fbitmap_spec_p (value
)))
3487 signal_error ("Invalid stipple attribute", value
);
3488 old_value
= LFACE_STIPPLE (lface
);
3489 LFACE_STIPPLE (lface
) = value
;
3490 #endif /* HAVE_X_WINDOWS */
3492 else if (EQ (attr
, QCwidth
))
3494 if (!UNSPECIFIEDP (value
))
3496 CHECK_SYMBOL (value
, 3);
3497 if (face_numeric_swidth (value
) < 0)
3498 signal_error ("Invalid face width", value
);
3500 old_value
= LFACE_SWIDTH (lface
);
3501 LFACE_SWIDTH (lface
) = value
;
3502 font_related_attr_p
= 1;
3504 else if (EQ (attr
, QCfont
))
3506 #ifdef HAVE_X_WINDOWS
3507 /* Set font-related attributes of the Lisp face from an
3511 CHECK_STRING (value
, 3);
3513 f
= SELECTED_FRAME ();
3515 f
= check_x_frame (frame
);
3517 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1, 1))
3518 signal_error ("Invalid font name", value
);
3520 font_related_attr_p
= 1;
3521 #endif /* HAVE_X_WINDOWS */
3523 else if (EQ (attr
, QCbold
))
3525 old_value
= LFACE_WEIGHT (lface
);
3526 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3527 font_related_attr_p
= 1;
3529 else if (EQ (attr
, QCitalic
))
3531 old_value
= LFACE_SLANT (lface
);
3532 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3533 font_related_attr_p
= 1;
3536 signal_error ("Invalid face attribute name", attr
);
3538 /* Changing a named face means that all realized faces depending on
3539 that face are invalid. Since we cannot tell which realized faces
3540 depend on the face, make sure they are all removed. This is done
3541 by incrementing face_change_count. The next call to
3542 init_iterator will then free realized faces. */
3544 && (EQ (attr
, QCfont
)
3545 || NILP (Fequal (old_value
, value
))))
3547 ++face_change_count
;
3548 ++windows_or_buffers_changed
;
3551 #ifdef HAVE_X_WINDOWS
3554 && !UNSPECIFIEDP (value
)
3555 && NILP (Fequal (old_value
, value
)))
3561 if (EQ (face
, Qdefault
))
3563 /* Changed font-related attributes of the `default' face are
3564 reflected in changed `font' frame parameters. */
3565 if (font_related_attr_p
3566 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3567 set_font_frame_param (frame
, lface
);
3568 else if (EQ (attr
, QCforeground
))
3569 param
= Qforeground_color
;
3570 else if (EQ (attr
, QCbackground
))
3571 param
= Qbackground_color
;
3573 else if (EQ (face
, Qscroll_bar
))
3575 /* Changing the colors of `scroll-bar' sets frame parameters
3576 `scroll-bar-foreground' and `scroll-bar-background'. */
3577 if (EQ (attr
, QCforeground
))
3578 param
= Qscroll_bar_foreground
;
3579 else if (EQ (attr
, QCbackground
))
3580 param
= Qscroll_bar_background
;
3582 else if (EQ (face
, Qborder
))
3584 /* Changing background color of `border' sets frame parameter
3586 if (EQ (attr
, QCbackground
))
3587 param
= Qborder_color
;
3589 else if (EQ (face
, Qcursor
))
3591 /* Changing background color of `cursor' sets frame parameter
3593 if (EQ (attr
, QCbackground
))
3594 param
= Qcursor_color
;
3596 else if (EQ (face
, Qmouse
))
3598 /* Changing background color of `mouse' sets frame parameter
3600 if (EQ (attr
, QCbackground
))
3601 param
= Qmouse_color
;
3604 if (SYMBOLP (param
))
3605 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3608 #endif /* HAVE_X_WINDOWS */
3614 #ifdef HAVE_X_WINDOWS
3616 /* Set the `font' frame parameter of FRAME according to `default' face
3617 attributes LFACE. */
3620 set_font_frame_param (frame
, lface
)
3621 Lisp_Object frame
, lface
;
3623 struct frame
*f
= XFRAME (frame
);
3624 Lisp_Object frame_font
;
3628 /* Get FRAME's font parameter. */
3629 frame_font
= Fassq (Qfont
, f
->param_alist
);
3630 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3631 frame_font
= XCDR (frame_font
);
3633 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3636 /* Frame parameter is a fontset name. Modify the fontset so
3637 that all its fonts reflect face attributes LFACE. */
3639 struct fontset_info
*fontset_info
;
3641 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3643 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3644 if (fontset_info
->fontname
[charset
])
3646 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3648 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3649 build_string (font
), frame
);
3655 /* Frame parameter is an X font name. I believe this can
3656 only happen in unibyte mode. */
3657 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3658 -1, Vface_default_registry
);
3661 store_frame_param (f
, Qfont
, build_string (font
));
3668 /* Update the corresponding face when frame parameter PARAM on frame F
3669 has been assigned the value NEW_VALUE. */
3672 update_face_from_frame_parameter (f
, param
, new_value
)
3674 Lisp_Object param
, new_value
;
3678 /* If there are no faces yet, give up. This is the case when called
3679 from Fx_create_frame, and we do the necessary things later in
3680 face-set-after-frame-defaults. */
3681 if (NILP (f
->face_alist
))
3684 if (EQ (param
, Qforeground_color
))
3686 lface
= lface_from_face_name (f
, Qdefault
, 1);
3687 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3688 ? new_value
: Qunspecified
);
3689 realize_basic_faces (f
);
3691 else if (EQ (param
, Qbackground_color
))
3695 /* Changing the background color might change the background
3696 mode, so that we have to load new defface specs. Call
3697 frame-update-face-colors to do that. */
3698 XSETFRAME (frame
, f
);
3699 call1 (Qframe_update_face_colors
, frame
);
3701 lface
= lface_from_face_name (f
, Qdefault
, 1);
3702 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3703 ? new_value
: Qunspecified
);
3704 realize_basic_faces (f
);
3706 if (EQ (param
, Qborder_color
))
3708 lface
= lface_from_face_name (f
, Qborder
, 1);
3709 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3710 ? new_value
: Qunspecified
);
3712 else if (EQ (param
, Qcursor_color
))
3714 lface
= lface_from_face_name (f
, Qcursor
, 1);
3715 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3716 ? new_value
: Qunspecified
);
3718 else if (EQ (param
, Qmouse_color
))
3720 lface
= lface_from_face_name (f
, Qmouse
, 1);
3721 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3722 ? new_value
: Qunspecified
);
3727 /* Get the value of X resource RESOURCE, class CLASS for the display
3728 of frame FRAME. This is here because ordinary `x-get-resource'
3729 doesn't take a frame argument. */
3731 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3732 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3733 (resource
, class, frame
)
3734 Lisp_Object resource
, class, frame
;
3737 CHECK_STRING (resource
, 0);
3738 CHECK_STRING (class, 1);
3739 CHECK_LIVE_FRAME (frame
, 2);
3741 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3742 resource
, class, Qnil
, Qnil
);
3748 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3749 If VALUE is "on" or "true", return t. If VALUE is "off" or
3750 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3751 error; if SIGNAL_P is zero, return 0. */
3754 face_boolean_x_resource_value (value
, signal_p
)
3758 Lisp_Object result
= make_number (0);
3760 xassert (STRINGP (value
));
3762 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3763 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3765 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3766 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3768 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3769 result
= Qunspecified
;
3771 signal_error ("Invalid face attribute value from X resource", value
);
3777 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3778 Finternal_set_lisp_face_attribute_from_resource
,
3779 Sinternal_set_lisp_face_attribute_from_resource
,
3781 (face
, attr
, value
, frame
)
3782 Lisp_Object face
, attr
, value
, frame
;
3784 CHECK_SYMBOL (face
, 0);
3785 CHECK_SYMBOL (attr
, 1);
3786 CHECK_STRING (value
, 2);
3788 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3789 value
= Qunspecified
;
3790 else if (EQ (attr
, QCheight
))
3792 value
= Fstring_to_number (value
, make_number (10));
3793 if (XINT (value
) <= 0)
3794 signal_error ("Invalid face height from X resource", value
);
3796 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3797 value
= face_boolean_x_resource_value (value
, 1);
3798 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3799 value
= intern (XSTRING (value
)->data
);
3800 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3801 value
= face_boolean_x_resource_value (value
, 1);
3802 else if (EQ (attr
, QCunderline
)
3803 || EQ (attr
, QCoverline
)
3804 || EQ (attr
, QCstrike_through
)
3805 || EQ (attr
, QCbox
))
3807 Lisp_Object boolean_value
;
3809 /* If the result of face_boolean_x_resource_value is t or nil,
3810 VALUE does NOT specify a color. */
3811 boolean_value
= face_boolean_x_resource_value (value
, 0);
3812 if (SYMBOLP (boolean_value
))
3813 value
= boolean_value
;
3816 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3821 /***********************************************************************
3823 ***********************************************************************/
3825 #ifdef USE_X_TOOLKIT
3827 /* Structure used to pass X resources to functions called via
3828 XtApplyToWidgets. */
3839 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3840 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3843 /* Set widget W's X resources from P which points to an x_resources
3844 structure. If W is a cascade button, apply resources to W's
3848 xm_apply_resources (w
, p
)
3853 struct x_resources
*res
= (struct x_resources
*) p
;
3855 XtSetValues (w
, res
->av
, res
->ac
);
3856 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3859 XtSetValues (submenu
, res
->av
, res
->ac
);
3860 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3865 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3866 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3869 1. Setting the XmNfontList resource leads to an infinite loop
3870 somewhere in LessTif. */
3873 xm_set_menu_resources_from_menu_face (f
, widget
)
3883 lface
= lface_from_face_name (f
, Qmenu
, 1);
3884 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3886 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3888 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
3892 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3894 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
3898 /* If any font-related attribute of `menu' is set, set the font. */
3900 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3901 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3902 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3903 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3904 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3906 #if 0 /* Setting the font leads to an infinite loop somewhere
3907 in LessTif during geometry computation. */
3909 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
3910 fl
= XmFontListAppendEntry (NULL
, fe
);
3911 XtSetArg (av
[ac
], XmNfontList
, fl
);
3916 xassert (ac
<= sizeof av
/ sizeof *av
);
3920 struct x_resources res
;
3922 XtSetValues (widget
, av
, ac
);
3923 res
.av
= av
, res
.ac
= ac
;
3924 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
3926 XmFontListFree (fl
);
3931 #endif /* USE_MOTIF */
3935 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
3936 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3939 /* Set widget W's resources from P which points to an x_resources
3943 xl_apply_resources (widget
, p
)
3947 struct x_resources
*res
= (struct x_resources
*) p
;
3948 XtSetValues (widget
, res
->av
, res
->ac
);
3952 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
3953 This is the Lucid version. */
3956 xl_set_menu_resources_from_menu_face (f
, widget
)
3965 lface
= lface_from_face_name (f
, Qmenu
, 1);
3966 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3968 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3970 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
3974 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3976 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
3981 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3982 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3983 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3984 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3985 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3987 XtSetArg (av
[ac
], XtNfont
, face
->font
);
3993 struct x_resources res
;
3995 XtSetValues (widget
, av
, ac
);
3997 /* We must do children here in case we're handling a pop-up menu
3998 in which case WIDGET is a popup shell. XtApplyToWidgets
3999 is a function from lwlib. */
4000 res
.av
= av
, res
.ac
= ac
;
4001 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4005 #endif /* USE_LUCID */
4008 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4011 x_set_menu_resources_from_menu_face (f
, widget
)
4015 /* Realized faces may have been removed on frame F, e.g. because of
4016 face attribute changes. Recompute them, if necessary, since we
4017 will need the `menu' face. */
4018 if (f
->face_cache
->used
== 0)
4019 recompute_basic_faces (f
);
4022 xl_set_menu_resources_from_menu_face (f
, widget
);
4025 xm_set_menu_resources_from_menu_face (f
, widget
);
4029 #endif /* USE_X_TOOLKIT */
4031 #endif /* HAVE_X_WINDOWS */
4035 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4036 Sinternal_get_lisp_face_attribute
,
4038 "Return face attribute KEYWORD of face SYMBOL.\n\
4039 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4040 face attribute name, signal an error.\n\
4041 If the optional argument FRAME is given, report on face FACE in that\n\
4042 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4043 frames). If FRAME is omitted or nil, use the selected frame.")
4044 (symbol
, keyword
, frame
)
4045 Lisp_Object symbol
, keyword
, frame
;
4047 Lisp_Object lface
, value
= Qnil
;
4049 CHECK_SYMBOL (symbol
, 0);
4050 CHECK_SYMBOL (keyword
, 1);
4053 lface
= lface_from_face_name (NULL
, symbol
, 1);
4057 frame
= selected_frame
;
4058 CHECK_LIVE_FRAME (frame
, 2);
4059 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4062 if (EQ (keyword
, QCfamily
))
4063 value
= LFACE_FAMILY (lface
);
4064 else if (EQ (keyword
, QCheight
))
4065 value
= LFACE_HEIGHT (lface
);
4066 else if (EQ (keyword
, QCweight
))
4067 value
= LFACE_WEIGHT (lface
);
4068 else if (EQ (keyword
, QCslant
))
4069 value
= LFACE_SLANT (lface
);
4070 else if (EQ (keyword
, QCunderline
))
4071 value
= LFACE_UNDERLINE (lface
);
4072 else if (EQ (keyword
, QCoverline
))
4073 value
= LFACE_OVERLINE (lface
);
4074 else if (EQ (keyword
, QCstrike_through
))
4075 value
= LFACE_STRIKE_THROUGH (lface
);
4076 else if (EQ (keyword
, QCbox
))
4077 value
= LFACE_BOX (lface
);
4078 else if (EQ (keyword
, QCinverse_video
)
4079 || EQ (keyword
, QCreverse_video
))
4080 value
= LFACE_INVERSE (lface
);
4081 else if (EQ (keyword
, QCforeground
))
4082 value
= LFACE_FOREGROUND (lface
);
4083 else if (EQ (keyword
, QCbackground
))
4084 value
= LFACE_BACKGROUND (lface
);
4085 else if (EQ (keyword
, QCstipple
))
4086 value
= LFACE_STIPPLE (lface
);
4087 else if (EQ (keyword
, QCwidth
))
4088 value
= LFACE_SWIDTH (lface
);
4090 signal_error ("Invalid face attribute name", keyword
);
4096 DEFUN ("internal-lisp-face-attribute-values",
4097 Finternal_lisp_face_attribute_values
,
4098 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4099 "Return a list of valid discrete values for face attribute ATTR.\n\
4100 Value is nil if ATTR doesn't have a discrete set of valid values.")
4104 Lisp_Object result
= Qnil
;
4106 CHECK_SYMBOL (attr
, 0);
4108 if (EQ (attr
, QCweight
)
4109 || EQ (attr
, QCslant
)
4110 || EQ (attr
, QCwidth
))
4112 /* Extract permissible symbols from tables. */
4113 struct table_entry
*table
;
4116 if (EQ (attr
, QCweight
))
4117 table
= weight_table
, dim
= DIM (weight_table
);
4118 else if (EQ (attr
, QCslant
))
4119 table
= slant_table
, dim
= DIM (slant_table
);
4121 table
= swidth_table
, dim
= DIM (swidth_table
);
4123 for (i
= 0; i
< dim
; ++i
)
4125 Lisp_Object symbol
= *table
[i
].symbol
;
4126 Lisp_Object tail
= result
;
4129 && !EQ (XCAR (tail
), symbol
))
4133 result
= Fcons (symbol
, result
);
4136 else if (EQ (attr
, QCunderline
))
4137 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4138 else if (EQ (attr
, QCoverline
))
4139 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4140 else if (EQ (attr
, QCstrike_through
))
4141 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4142 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4143 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4149 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4150 Sinternal_merge_in_global_face
, 2, 2, 0,
4151 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4153 Lisp_Object face
, frame
;
4155 Lisp_Object global_lface
, local_lface
;
4156 CHECK_LIVE_FRAME (frame
, 1);
4157 global_lface
= lface_from_face_name (NULL
, face
, 1);
4158 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4159 if (NILP (local_lface
))
4160 local_lface
= Finternal_make_lisp_face (face
, frame
);
4161 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4162 XVECTOR (local_lface
)->contents
);
4167 /* The following function is implemented for compatibility with 20.2.
4168 The function is used in x-resolve-fonts when it is asked to
4169 return fonts with the same size as the font of a face. This is
4170 done in fontset.el. */
4172 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4173 "Return the font name of face FACE, or nil if it is unspecified.\n\
4174 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4175 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4176 The font default for a face is either nil, or a list\n\
4177 of the form (bold), (italic) or (bold italic).\n\
4178 If FRAME is omitted or nil, use the selected frame.")
4180 Lisp_Object face
, frame
;
4184 Lisp_Object result
= Qnil
;
4185 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4187 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4188 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4189 result
= Fcons (Qbold
, result
);
4191 if (!NILP (LFACE_SLANT (lface
))
4192 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4193 result
= Fcons (Qitalic
, result
);
4199 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4200 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
4201 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4202 return build_string (face
->font_name
);
4207 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4208 all attributes are `equal'. Tries to be fast because this function
4209 is called quite often. */
4212 lface_equal_p (v1
, v2
)
4213 Lisp_Object
*v1
, *v2
;
4217 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4219 Lisp_Object a
= v1
[i
];
4220 Lisp_Object b
= v2
[i
];
4222 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4223 and the other is specified. */
4224 equal_p
= XTYPE (a
) == XTYPE (b
);
4233 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4234 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4235 XSTRING (a
)->size
) == 0);
4244 equal_p
= !NILP (Fequal (a
, b
));
4254 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4255 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4256 "True if FACE1 and FACE2 are equal.\n\
4257 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4258 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4259 If FRAME is omitted or nil, use the selected frame.")
4260 (face1
, face2
, frame
)
4261 Lisp_Object face1
, face2
, frame
;
4265 Lisp_Object lface1
, lface2
;
4270 /* Don't use check_x_frame here because this function is called
4271 before X frames exist. At that time, if FRAME is nil,
4272 selected_frame will be used which is the frame dumped with
4273 Emacs. That frame is not an X frame. */
4274 f
= frame_or_selected_frame (frame
, 2);
4276 lface1
= lface_from_face_name (NULL
, face1
, 1);
4277 lface2
= lface_from_face_name (NULL
, face2
, 1);
4278 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4279 XVECTOR (lface2
)->contents
);
4280 return equal_p
? Qt
: Qnil
;
4284 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4285 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4286 "True if FACE has no attribute specified.\n\
4287 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4288 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4289 If FRAME is omitted or nil, use the selected frame.")
4291 Lisp_Object face
, frame
;
4298 frame
= selected_frame
;
4299 CHECK_LIVE_FRAME (frame
, 0);
4303 lface
= lface_from_face_name (NULL
, face
, 1);
4305 lface
= lface_from_face_name (f
, face
, 1);
4307 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4308 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4311 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4315 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4317 "Return an alist of frame-local faces defined on FRAME.\n\
4318 For internal use only.")
4322 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4323 return f
->face_alist
;
4327 /* Return a hash code for Lisp string STRING with case ignored. Used
4328 below in computing a hash value for a Lisp face. */
4330 static INLINE
unsigned
4331 hash_string_case_insensitive (string
)
4336 xassert (STRINGP (string
));
4337 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4338 hash
= (hash
<< 1) ^ tolower (*s
);
4343 /* Return a hash code for face attribute vector V. */
4345 static INLINE
unsigned
4349 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4350 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4351 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4352 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4353 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4354 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4355 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4359 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4360 considering charsets/registries). They do if they specify the same
4361 family, point size, weight, width and slant. Both LFACE1 and
4362 LFACE2 must be fully-specified. */
4365 lface_same_font_attributes_p (lface1
, lface2
)
4366 Lisp_Object
*lface1
, *lface2
;
4368 xassert (lface_fully_specified_p (lface1
)
4369 && lface_fully_specified_p (lface2
));
4370 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4371 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4372 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4373 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4374 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4375 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4376 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4381 /***********************************************************************
4383 ***********************************************************************/
4385 /* Allocate and return a new realized face for Lisp face attribute
4386 vector ATTR, charset CHARSET, and registry REGISTRY. */
4388 static struct face
*
4389 make_realized_face (attr
, charset
, registry
)
4392 Lisp_Object registry
;
4394 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4395 bzero (face
, sizeof *face
);
4396 face
->charset
= charset
;
4397 face
->registry
= registry
;
4398 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4403 /* Free realized face FACE, including its X resources. FACE may
4407 free_realized_face (f
, face
)
4413 #ifdef HAVE_X_WINDOWS
4418 x_free_gc (f
, face
->gc
);
4422 free_face_colors (f
, face
);
4423 x_destroy_bitmap (f
, face
->stipple
);
4425 #endif /* HAVE_X_WINDOWS */
4432 /* Prepare face FACE for subsequent display on frame F. This
4433 allocated GCs if they haven't been allocated yet or have been freed
4434 by clearing the face cache. */
4437 prepare_face_for_display (f
, face
)
4441 #ifdef HAVE_X_WINDOWS
4442 xassert (FRAME_X_P (f
));
4447 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4449 xgcv
.foreground
= face
->foreground
;
4450 xgcv
.background
= face
->background
;
4451 xgcv
.graphics_exposures
= False
;
4453 /* The font of FACE may be null if we couldn't load it. */
4456 xgcv
.font
= face
->font
->fid
;
4463 xgcv
.fill_style
= FillOpaqueStippled
;
4464 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4465 mask
|= GCFillStyle
| GCStipple
;
4468 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4475 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4476 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4477 ISO8859-1 if the ASCII face suffices. */
4480 face_suitable_for_iso8859_1_p (face
)
4483 int len
= strlen (face
->font_name
);
4484 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4488 /* Value is non-zero if FACE is suitable for displaying characters
4489 of CHARSET. CHARSET < 0 means unibyte text. */
4492 face_suitable_for_charset_p (face
, charset
)
4500 if (EQ (face
->registry
, Vface_default_registry
)
4501 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4504 else if (face
->charset
== charset
)
4506 else if (face
->charset
== CHARSET_ASCII
4507 && charset
== charset_latin_iso8859_1
)
4508 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4509 else if (face
->charset
== charset_latin_iso8859_1
4510 && charset
== CHARSET_ASCII
)
4518 /***********************************************************************
4520 ***********************************************************************/
4522 /* Return a new face cache for frame F. */
4524 static struct face_cache
*
4528 struct face_cache
*c
;
4531 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4532 bzero (c
, sizeof *c
);
4533 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4534 c
->buckets
= (struct face
**) xmalloc (size
);
4535 bzero (c
->buckets
, size
);
4537 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4543 /* Clear out all graphics contexts for all realized faces, except for
4544 the basic faces. This should be done from time to time just to avoid
4545 keeping too many graphics contexts that are no longer needed. */
4549 struct face_cache
*c
;
4551 if (c
&& FRAME_X_P (c
->f
))
4553 #ifdef HAVE_X_WINDOWS
4555 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4557 struct face
*face
= c
->faces_by_id
[i
];
4558 if (face
&& face
->gc
)
4560 x_free_gc (c
->f
, face
->gc
);
4564 #endif /* HAVE_X_WINDOWS */
4569 /* Free all realized faces in face cache C, including basic faces. C
4570 may be null. If faces are freed, make sure the frame's current
4571 matrix is marked invalid, so that a display caused by an expose
4572 event doesn't try to use faces we destroyed. */
4575 free_realized_faces (c
)
4576 struct face_cache
*c
;
4581 struct frame
*f
= c
->f
;
4583 for (i
= 0; i
< c
->used
; ++i
)
4585 free_realized_face (f
, c
->faces_by_id
[i
]);
4586 c
->faces_by_id
[i
] = NULL
;
4590 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4591 bzero (c
->buckets
, size
);
4593 /* Must do a thorough redisplay the next time. Mark current
4594 matrices as invalid because they will reference faces freed
4595 above. This function is also called when a frame is
4596 destroyed. In this case, the root window of F is nil. */
4597 if (WINDOWP (f
->root_window
))
4599 clear_current_matrices (f
);
4600 ++windows_or_buffers_changed
;
4606 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4607 This is done after attributes of a named face have been changed,
4608 because we can't tell which realized faces depend on that face. */
4611 free_all_realized_faces (frame
)
4617 FOR_EACH_FRAME (rest
, frame
)
4618 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4621 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4625 /* Free face cache C and faces in it, including their X resources. */
4629 struct face_cache
*c
;
4633 free_realized_faces (c
);
4635 xfree (c
->faces_by_id
);
4641 /* Cache realized face FACE in face cache C. HASH is the hash value
4642 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4643 collision list of the face hash table of C. This is done because
4644 otherwise lookup_face would find FACE for every charset, even if
4645 faces with the same attributes but for specific charsets exist. */
4648 cache_face (c
, face
, hash
)
4649 struct face_cache
*c
;
4653 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4657 if (face
->fontset
>= 0)
4659 struct face
*last
= c
->buckets
[i
];
4670 c
->buckets
[i
] = face
;
4671 face
->prev
= face
->next
= NULL
;
4677 face
->next
= c
->buckets
[i
];
4679 face
->next
->prev
= face
;
4680 c
->buckets
[i
] = face
;
4683 /* Find a free slot in C->faces_by_id and use the index of the free
4684 slot as FACE->id. */
4685 for (i
= 0; i
< c
->used
; ++i
)
4686 if (c
->faces_by_id
[i
] == NULL
)
4690 /* Maybe enlarge C->faces_by_id. */
4691 if (i
== c
->used
&& c
->used
== c
->size
)
4693 int new_size
= 2 * c
->size
;
4694 int sz
= new_size
* sizeof *c
->faces_by_id
;
4695 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4700 /* Check that FACE got a unique id. */
4705 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4706 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4712 #endif /* GLYPH_DEBUG */
4714 c
->faces_by_id
[i
] = face
;
4720 /* Remove face FACE from cache C. */
4723 uncache_face (c
, face
)
4724 struct face_cache
*c
;
4727 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4730 face
->prev
->next
= face
->next
;
4732 c
->buckets
[i
] = face
->next
;
4735 face
->next
->prev
= face
->prev
;
4737 c
->faces_by_id
[face
->id
] = NULL
;
4738 if (face
->id
== c
->used
)
4743 /* Look up a realized face with face attributes ATTR in the face cache
4744 of frame F. The face will be used to display characters of
4745 CHARSET. CHARSET < 0 means the face will be used to display
4746 unibyte text. The value of face-default-registry is used to choose
4747 a font for the face in that case. Value is the ID of the face
4748 found. If no suitable face is found, realize a new one. */
4751 lookup_face (f
, attr
, charset
)
4756 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4761 xassert (c
!= NULL
);
4762 check_lface_attrs (attr
);
4764 /* Look up ATTR in the face cache. */
4765 hash
= lface_hash (attr
);
4766 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4768 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4769 if (face
->hash
== hash
4770 && (!FRAME_WINDOW_P (f
)
4771 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4772 && lface_equal_p (face
->lface
, attr
))
4775 /* If not found, realize a new face. */
4778 face
= realize_face (c
, attr
, charset
);
4779 cache_face (c
, face
, hash
);
4783 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4785 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4786 #endif /* GLYPH_DEBUG */
4792 /* Return the face id of the realized face for named face SYMBOL on
4793 frame F suitable for displaying characters from CHARSET. CHARSET <
4794 0 means unibyte text. */
4797 lookup_named_face (f
, symbol
, charset
)
4802 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4803 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4804 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4806 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4807 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4808 merge_face_vectors (symbol_attrs
, attrs
);
4809 return lookup_face (f
, attrs
, charset
);
4813 /* Return the ID of the realized ASCII face of Lisp face with ID
4814 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4817 ascii_face_of_lisp_face (f
, lface_id
)
4823 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4825 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4826 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4835 /* Return a face for charset ASCII that is like the face with id
4836 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4837 STEPS < 0 means larger. Value is the id of the face. */
4840 smaller_face (f
, face_id
, steps
)
4844 #ifdef HAVE_X_WINDOWS
4846 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4847 int pt
, last_pt
, last_height
;
4850 struct face
*new_face
;
4852 /* If not called for an X frame, just return the original face. */
4853 if (FRAME_TERMCAP_P (f
))
4856 /* Try in increments of 1/2 pt. */
4857 delta
= steps
< 0 ? 5 : -5;
4858 steps
= abs (steps
);
4860 face
= FACE_FROM_ID (f
, face_id
);
4861 bcopy (face
->lface
, attrs
, sizeof attrs
);
4862 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4863 new_face_id
= face_id
;
4864 last_height
= FONT_HEIGHT (face
->font
);
4868 /* Give up if we cannot find a font within 10pt. */
4869 && abs (last_pt
- pt
) < 100)
4871 /* Look up a face for a slightly smaller/larger font. */
4873 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4874 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4875 new_face
= FACE_FROM_ID (f
, new_face_id
);
4877 /* If height changes, count that as one step. */
4878 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4881 last_height
= FONT_HEIGHT (new_face
->font
);
4888 #else /* not HAVE_X_WINDOWS */
4892 #endif /* not HAVE_X_WINDOWS */
4896 /* Return a face for charset ASCII that is like the face with id
4897 FACE_ID on frame F, but has height HEIGHT. */
4900 face_with_height (f
, face_id
, height
)
4905 #ifdef HAVE_X_WINDOWS
4907 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4909 if (FRAME_TERMCAP_P (f
)
4913 face
= FACE_FROM_ID (f
, face_id
);
4914 bcopy (face
->lface
, attrs
, sizeof attrs
);
4915 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4916 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4917 #endif /* HAVE_X_WINDOWS */
4922 /* Return the face id of the realized face for named face SYMBOL on
4923 frame F suitable for displaying characters from CHARSET (CHARSET <
4924 0 means unibyte text), and use attributes of the face FACE_ID for
4925 attributes that aren't completely specified by SYMBOL. This is
4926 like lookup_named_face, except that the default attributes come
4927 from FACE_ID, not from the default face. FACE_ID is assumed to
4928 be already realized. */
4931 lookup_derived_face (f
, symbol
, charset
, face_id
)
4937 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4938 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4939 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4944 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4945 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4946 merge_face_vectors (symbol_attrs
, attrs
);
4947 return lookup_face (f
, attrs
, charset
);
4952 /***********************************************************************
4954 ***********************************************************************/
4956 DEFUN ("internal-set-font-selection-order",
4957 Finternal_set_font_selection_order
,
4958 Sinternal_set_font_selection_order
, 1, 1, 0,
4959 "Set font selection order for face font selection to ORDER.\n\
4960 ORDER must be a list of length 4 containing the symbols `:width',\n\
4961 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4962 first in ORDER are matched first, e.g. if `:height' appears before\n\
4963 `:weight' in ORDER, font selection first tries to find a font with\n\
4964 a suitable height, and then tries to match the font weight.\n\
4973 CHECK_LIST (order
, 0);
4974 bzero (indices
, sizeof indices
);
4978 CONSP (list
) && i
< DIM (indices
);
4979 list
= XCDR (list
), ++i
)
4981 Lisp_Object attr
= XCAR (list
);
4984 if (EQ (attr
, QCwidth
))
4986 else if (EQ (attr
, QCheight
))
4987 xlfd
= XLFD_POINT_SIZE
;
4988 else if (EQ (attr
, QCweight
))
4990 else if (EQ (attr
, QCslant
))
4995 if (indices
[i
] != 0)
5001 || i
!= DIM (indices
)
5006 signal_error ("Invalid font sort order", order
);
5008 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5010 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5011 free_all_realized_faces (Qnil
);
5018 DEFUN ("internal-set-alternative-font-family-alist",
5019 Finternal_set_alternative_font_family_alist
,
5020 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5021 "Define alternative font families to try in face font selection.\n\
5022 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5023 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5024 be found. Value is ALIST.")
5028 CHECK_LIST (alist
, 0);
5029 Vface_alternative_font_family_alist
= alist
;
5030 free_all_realized_faces (Qnil
);
5035 #ifdef HAVE_X_WINDOWS
5037 /* Return the X registry and encoding of font name FONT_NAME on frame F.
5038 Value is nil if not successful. */
5041 deduce_unibyte_registry (f
, font_name
)
5045 struct font_name font
;
5046 Lisp_Object registry
= Qnil
;
5048 font
.name
= STRDUPA (font_name
);
5049 if (split_font_name (f
, &font
, 0))
5053 /* Extract registry and encoding. */
5054 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
5055 + strlen (font
.fields
[XLFD_ENCODING
])
5057 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
5058 strcat (buffer
, "-");
5059 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
5060 registry
= build_string (buffer
);
5067 /* Value is non-zero if FONT is the name of a scalable font. The
5068 X11R6 XLFD spec says that point size, pixel size, and average width
5069 are zero for scalable fonts. Intlfonts contain at least one
5070 scalable font ("*-muleindian-1") for which this isn't true, so we
5071 just test average width. */
5074 font_scalable_p (font
)
5075 struct font_name
*font
;
5077 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5078 return *s
== '0' && *(s
+ 1) == '\0';
5082 /* Value is non-zero if FONT1 is a better match for font attributes
5083 VALUES than FONT2. VALUES is an array of face attribute values in
5084 font sort order. COMPARE_PT_P zero means don't compare point
5088 better_font_p (values
, font1
, font2
, compare_pt_p
)
5090 struct font_name
*font1
, *font2
;
5095 for (i
= 0; i
< 4; ++i
)
5097 int xlfd_idx
= font_sort_order
[i
];
5099 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5101 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5102 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5104 if (delta1
> delta2
)
5106 else if (delta1
< delta2
)
5110 /* The difference may be equal because, e.g., the face
5111 specifies `italic' but we have only `regular' and
5112 `oblique'. Prefer `oblique' in this case. */
5113 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5114 && font1
->numeric
[xlfd_idx
] > values
[i
]
5115 && font2
->numeric
[xlfd_idx
] < values
[i
])
5127 /* Value is non-zero if FONT is an exact match for face attributes in
5128 SPECIFIED. SPECIFIED is an array of face attribute values in font
5132 exact_face_match_p (specified
, font
)
5134 struct font_name
*font
;
5138 for (i
= 0; i
< 4; ++i
)
5139 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5146 /* Value is the name of a scaled font, generated from scalable font
5147 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5148 Value is allocated from heap. */
5151 build_scalable_font_name (f
, font
, specified_pt
)
5153 struct font_name
*font
;
5156 char point_size
[20], pixel_size
[20];
5158 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5161 /* If scalable font is for a specific resolution, compute
5162 the point size we must specify from the resolution of
5163 the display and the specified resolution of the font. */
5164 if (font
->numeric
[XLFD_RESY
] != 0)
5166 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5167 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5172 pixel_value
= resy
/ 720.0 * pt
;
5175 /* Set point size of the font. */
5176 sprintf (point_size
, "%d", (int) pt
);
5177 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5178 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5180 /* Set pixel size. */
5181 sprintf (pixel_size
, "%d", pixel_value
);
5182 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5183 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5185 /* If font doesn't specify its resolution, use the
5186 resolution of the display. */
5187 if (font
->numeric
[XLFD_RESY
] == 0)
5190 sprintf (buffer
, "%d", (int) resy
);
5191 font
->fields
[XLFD_RESY
] = buffer
;
5192 font
->numeric
[XLFD_RESY
] = resy
;
5195 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5198 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5199 sprintf (buffer
, "%d", resx
);
5200 font
->fields
[XLFD_RESX
] = buffer
;
5201 font
->numeric
[XLFD_RESX
] = resx
;
5204 return build_font_name (font
);
5208 /* Value is non-zero if we are allowed to use scalable font FONT. We
5209 can't run a Lisp function here since this function may be called
5210 with input blocked. */
5213 may_use_scalable_font_p (font
, name
)
5214 struct font_name
*font
;
5217 if (EQ (Vscalable_fonts_allowed
, Qt
))
5219 else if (CONSP (Vscalable_fonts_allowed
))
5221 Lisp_Object tail
, regexp
;
5223 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5225 regexp
= XCAR (tail
);
5226 if (STRINGP (regexp
)
5227 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5235 #endif /* SCALABLE_FONTS != 0 */
5238 /* Return the name of the best matching font for face attributes
5239 ATTRS in the array of font_name structures FONTS which contains
5240 NFONTS elements. Value is a font name which is allocated from
5241 the heap. FONTS is freed by this function. */
5244 best_matching_font (f
, attrs
, fonts
, nfonts
)
5247 struct font_name
*fonts
;
5251 struct font_name
*best
;
5259 /* Make specified font attributes available in `specified',
5260 indexed by sort order. */
5261 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5263 int xlfd_idx
= font_sort_order
[i
];
5265 if (xlfd_idx
== XLFD_SWIDTH
)
5266 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5267 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5268 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5269 else if (xlfd_idx
== XLFD_WEIGHT
)
5270 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5271 else if (xlfd_idx
== XLFD_SLANT
)
5272 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5282 /* Start with the first non-scalable font in the list. */
5283 for (i
= 0; i
< nfonts
; ++i
)
5284 if (!font_scalable_p (fonts
+ i
))
5287 /* Find the best match among the non-scalable fonts. */
5292 for (i
= 1; i
< nfonts
; ++i
)
5293 if (!font_scalable_p (fonts
+ i
)
5294 && better_font_p (specified
, fonts
+ i
, best
, 1))
5298 exact_p
= exact_face_match_p (specified
, best
);
5307 /* Unless we found an exact match among non-scalable fonts, see if
5308 we can find a better match among scalable fonts. */
5311 /* A scalable font is better if
5313 1. its weight, slant, swidth attributes are better, or.
5315 2. the best non-scalable font doesn't have the required
5316 point size, and the scalable fonts weight, slant, swidth
5319 int non_scalable_has_exact_height_p
;
5321 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5322 non_scalable_has_exact_height_p
= 1;
5324 non_scalable_has_exact_height_p
= 0;
5326 for (i
= 0; i
< nfonts
; ++i
)
5327 if (font_scalable_p (fonts
+ i
))
5330 || better_font_p (specified
, fonts
+ i
, best
, 0)
5331 || (!non_scalable_has_exact_height_p
5332 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5337 if (font_scalable_p (best
))
5338 font_name
= build_scalable_font_name (f
, best
, pt
);
5340 font_name
= build_font_name (best
);
5342 #else /* !SCALABLE_FONTS */
5344 /* Find the best non-scalable font. */
5347 for (i
= 1; i
< nfonts
; ++i
)
5349 xassert (!font_scalable_p (fonts
+ i
));
5350 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5354 font_name
= build_font_name (best
);
5356 #endif /* !SCALABLE_FONTS */
5358 /* Free font_name structures. */
5359 free_font_names (fonts
, nfonts
);
5365 /* Try to get a list of fonts on frame F with font family FAMILY and
5366 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5367 of font_name structures for the fonts matched. Value is the number
5371 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5374 char *pattern
, *family
, *registry
;
5375 struct font_name
**fonts
;
5380 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5382 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5388 /* Try alternative font families from
5389 Vface_alternative_font_family_alist. */
5390 alter
= Fassoc (build_string (family
),
5391 Vface_alternative_font_family_alist
);
5393 for (alter
= XCDR (alter
);
5394 CONSP (alter
) && nfonts
== 0;
5395 alter
= XCDR (alter
))
5397 if (STRINGP (XCAR (alter
)))
5399 family
= LSTRDUPA (XCAR (alter
));
5400 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5404 /* Try font family of the default face or "fixed". */
5407 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5409 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5412 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5415 /* Try any family with the given registry. */
5417 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5424 /* Return the registry and encoding pattern that fonts for CHARSET
5425 should match. Value is allocated from the heap. */
5428 x_charset_registry (charset
)
5431 Lisp_Object prop
, charset_plist
;
5434 /* Get registry and encoding from the charset's plist. */
5435 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5436 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5440 if (index (XSTRING (prop
)->data
, '-'))
5441 registry
= xstrdup (XSTRING (prop
)->data
);
5444 /* If registry doesn't contain a `-', make it a pattern. */
5445 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5446 strcpy (registry
, XSTRING (prop
)->data
);
5447 strcat (registry
, "*-*");
5450 else if (STRINGP (Vface_default_registry
))
5451 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5453 registry
= xstrdup ("iso8859-1");
5459 /* Return the fontset id of the fontset name or alias name given by
5460 the family attribute of ATTRS on frame F. Value is -1 if the
5461 family attribute of ATTRS doesn't name a fontset. */
5464 face_fontset (f
, attrs
)
5468 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5471 name
= Fquery_fontset (name
, Qnil
);
5475 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5481 /* Get the font to use for the face realizing the fully-specified Lisp
5482 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5483 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5484 in this case. Value is the font name which is allocated from the
5485 heap (which means that it must be freed eventually). */
5488 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5492 Lisp_Object unibyte_registry
;
5494 struct font_name
*fonts
;
5498 /* ATTRS must be fully-specified. */
5499 xassert (lface_fully_specified_p (attrs
));
5501 if (STRINGP (unibyte_registry
))
5502 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5504 registry
= x_charset_registry (charset
);
5506 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5508 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5512 /* Choose a font to use on frame F to display CHARSET using FONTSET
5513 with Lisp face attributes specified by ATTRS. CHARSET may be any
5514 valid charset. CHARSET < 0 means unibyte text. If the fontset
5515 doesn't contain a font pattern for charset, use the pattern for
5516 CHARSET_ASCII. Value is the font name which is allocated from the
5517 heap and must be freed by the caller. */
5520 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5523 int fontset
, charset
;
5526 char *font_name
= NULL
;
5527 struct fontset_info
*fontset_info
;
5528 struct font_name
*fonts
;
5531 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5533 /* For unibyte text, use the ASCII font of the fontset. Using the
5534 ASCII font seems to be the most reasonable thing we can do in
5537 charset
= CHARSET_ASCII
;
5539 /* Get the font name pattern to use for CHARSET from the fontset. */
5540 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5541 pattern
= fontset_info
->fontname
[charset
];
5543 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5546 /* Get a list of fonts matching that pattern and choose the
5547 best match for the specified face attributes from it. */
5548 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5549 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5553 #endif /* HAVE_X_WINDOWS */
5557 /***********************************************************************
5559 ***********************************************************************/
5561 /* Realize basic faces on frame F. Value is zero if frame parameters
5562 of F don't contain enough information needed to realize the default
5566 realize_basic_faces (f
)
5571 if (realize_default_face (f
))
5573 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5574 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5575 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5576 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5577 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5578 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5579 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5580 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5581 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5589 /* Realize the default face on frame F. If the face is not fully
5590 specified, make it fully-specified. Attributes of the default face
5591 that are not explicitly specified are taken from frame parameters. */
5594 realize_default_face (f
)
5597 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5599 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5600 Lisp_Object unibyte_registry
;
5601 Lisp_Object frame_font
;
5605 /* If the `default' face is not yet known, create it. */
5606 lface
= lface_from_face_name (f
, Qdefault
, 0);
5610 XSETFRAME (frame
, f
);
5611 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5614 #ifdef HAVE_X_WINDOWS
5617 /* Set frame_font to the value of the `font' frame parameter. */
5618 frame_font
= Fassq (Qfont
, f
->param_alist
);
5619 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5620 frame_font
= XCDR (frame_font
);
5622 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5625 /* If frame_font is a fontset name, don't use that for
5626 determining font-related attributes of the default face
5627 because it is just an artificial name. Use the ASCII font of
5628 the fontset, instead. */
5629 struct font_info
*font_info
;
5630 struct font_name font
;
5633 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5637 /* Set weight etc. from the ASCII font. */
5638 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0, 0))
5641 /* Remember registry and encoding of the frame font. */
5642 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5643 if (STRINGP (unibyte_registry
))
5644 Vface_default_registry
= unibyte_registry
;
5646 Vface_default_registry
= build_string ("iso8859-1");
5648 /* But set the family to the fontset alias name. Implementation
5649 note: When a font is passed to Emacs via `-fn FONT', a
5650 fontset is created in `x-win.el' whose name ends in
5651 `fontset-startup'. This fontset has an alias name that is
5652 equal to frame_font. */
5653 xassert (STRINGP (frame_font
));
5654 font
.name
= LSTRDUPA (frame_font
);
5656 if (!split_font_name (f
, &font
, 1)
5657 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5658 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5659 LFACE_FAMILY (lface
) = frame_font
;
5663 /* Frame parameters contain a real font. Fill default face
5664 attributes from that font. */
5665 if (!set_lface_from_font_name (f
, lface
,
5666 XSTRING (frame_font
)->data
, 0, 0))
5669 /* Remember registry and encoding of the frame font. */
5671 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5672 if (STRINGP (unibyte_registry
))
5673 Vface_default_registry
= unibyte_registry
;
5675 Vface_default_registry
= build_string ("iso8859-1");
5678 #endif /* HAVE_X_WINDOWS */
5680 if (!FRAME_WINDOW_P (f
))
5682 LFACE_FAMILY (lface
) = build_string ("default");
5683 LFACE_SWIDTH (lface
) = Qnormal
;
5684 LFACE_HEIGHT (lface
) = make_number (1);
5685 LFACE_WEIGHT (lface
) = Qnormal
;
5686 LFACE_SLANT (lface
) = Qnormal
;
5689 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5690 LFACE_UNDERLINE (lface
) = Qnil
;
5692 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5693 LFACE_OVERLINE (lface
) = Qnil
;
5695 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5696 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5698 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5699 LFACE_BOX (lface
) = Qnil
;
5701 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5702 LFACE_INVERSE (lface
) = Qnil
;
5704 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5706 /* This function is called so early that colors are not yet
5707 set in the frame parameter list. */
5708 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5710 if (CONSP (color
) && STRINGP (XCDR (color
)))
5711 LFACE_FOREGROUND (lface
) = XCDR (color
);
5712 else if (FRAME_X_P (f
))
5714 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5715 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5720 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5722 /* This function is called so early that colors are not yet
5723 set in the frame parameter list. */
5724 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5725 if (CONSP (color
) && STRINGP (XCDR (color
)))
5726 LFACE_BACKGROUND (lface
) = XCDR (color
);
5727 else if (FRAME_X_P (f
))
5729 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5730 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5735 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5736 LFACE_STIPPLE (lface
) = Qnil
;
5738 /* Realize the face; it must be fully-specified now. */
5739 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5740 check_lface (lface
);
5741 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5742 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5744 /* Remove the former default face. */
5745 if (c
->used
> DEFAULT_FACE_ID
)
5747 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5748 uncache_face (c
, default_face
);
5749 free_realized_face (f
, default_face
);
5752 /* Insert the new default face. */
5753 cache_face (c
, face
, lface_hash (attrs
));
5754 xassert (face
->id
== DEFAULT_FACE_ID
);
5759 /* Realize basic faces other than the default face in face cache C.
5760 SYMBOL is the face name, ID is the face id the realized face must
5761 have. The default face must have been realized already. */
5764 realize_named_face (f
, symbol
, id
)
5769 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5770 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5771 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5772 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5773 struct face
*new_face
;
5775 /* The default face must exist and be fully specified. */
5776 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5777 check_lface_attrs (attrs
);
5778 xassert (lface_fully_specified_p (attrs
));
5780 /* If SYMBOL isn't know as a face, create it. */
5784 XSETFRAME (frame
, f
);
5785 lface
= Finternal_make_lisp_face (symbol
, frame
);
5788 /* Merge SYMBOL's face with the default face. */
5789 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5790 merge_face_vectors (symbol_attrs
, attrs
);
5792 /* Realize the face. */
5793 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5795 /* Remove the former face. */
5798 struct face
*old_face
= c
->faces_by_id
[id
];
5799 uncache_face (c
, old_face
);
5800 free_realized_face (f
, old_face
);
5803 /* Insert the new face. */
5804 cache_face (c
, new_face
, lface_hash (attrs
));
5805 xassert (new_face
->id
== id
);
5809 /* Realize the fully-specified face with attributes ATTRS in face
5810 cache C for character set CHARSET or for unibyte text if CHARSET <
5811 0. Value is a pointer to the newly created realized face. */
5813 static struct face
*
5814 realize_face (c
, attrs
, charset
)
5815 struct face_cache
*c
;
5821 /* LFACE must be fully specified. */
5822 xassert (c
!= NULL
);
5823 check_lface_attrs (attrs
);
5825 if (FRAME_X_P (c
->f
))
5826 face
= realize_x_face (c
, attrs
, charset
);
5827 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5828 face
= realize_tty_face (c
, attrs
, charset
);
5836 /* Realize the fully-specified face with attributes ATTRS in face
5837 cache C for character set CHARSET or for unibyte text if CHARSET <
5838 0. Do it for X frame C->f. Value is a pointer to the newly
5839 created realized face. */
5841 static struct face
*
5842 realize_x_face (c
, attrs
, charset
)
5843 struct face_cache
*c
;
5847 #ifdef HAVE_X_WINDOWS
5848 struct face
*face
, *default_face
;
5850 Lisp_Object stipple
, overline
, strike_through
, box
;
5851 Lisp_Object unibyte_registry
;
5852 struct gcpro gcpro1
;
5854 xassert (FRAME_X_P (c
->f
));
5856 /* If realizing a face for use in unibyte text, get the X registry
5857 and encoding to use from Vface_default_registry. */
5859 unibyte_registry
= (STRINGP (Vface_default_registry
)
5860 ? Vface_default_registry
5861 : build_string ("iso8859-1"));
5863 unibyte_registry
= Qnil
;
5864 GCPRO1 (unibyte_registry
);
5866 /* Allocate a new realized face. */
5867 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5870 /* Determine the font to use. Most of the time, the font will be
5871 the same as the font of the default face, so try that first. */
5872 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5874 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5875 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5877 face
->font
= default_face
->font
;
5878 face
->fontset
= default_face
->fontset
;
5879 face
->font_info_id
= default_face
->font_info_id
;
5880 face
->font_name
= default_face
->font_name
;
5881 face
->registry
= default_face
->registry
;
5883 else if (charset
>= 0)
5885 /* For all charsets, we use our own font selection functions to
5886 choose a best matching font for the specified face
5887 attributes. If the face specifies a fontset alias name, the
5888 fontset determines the font name pattern, otherwise we
5889 construct a font pattern from face attributes and charset. */
5891 char *font_name
= NULL
;
5892 int fontset
= face_fontset (f
, attrs
);
5895 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5898 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5902 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5907 /* Unibyte case, and font is not equal to that of the default
5908 face. UNIBYTE_REGISTRY is the X registry and encoding the
5909 font should have. What is a reasonable thing to do if the
5910 user specified a fontset alias name for the face in this
5911 case? We choose a font by taking the ASCII font of the
5912 fontset, but using UNIBYTE_REGISTRY for its registry and
5915 char *font_name
= NULL
;
5916 int fontset
= face_fontset (f
, attrs
);
5919 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5921 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5923 load_face_font_or_fontset (f
, face
, font_name
, -1);
5927 /* Load colors, and set remaining attributes. */
5929 load_face_colors (f
, face
, attrs
);
5932 box
= attrs
[LFACE_BOX_INDEX
];
5935 /* A simple box of line width 1 drawn in color given by
5937 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5939 face
->box
= FACE_SIMPLE_BOX
;
5940 face
->box_line_width
= 1;
5942 else if (INTEGERP (box
))
5944 /* Simple box of specified line width in foreground color of the
5946 xassert (XINT (box
) > 0);
5947 face
->box
= FACE_SIMPLE_BOX
;
5948 face
->box_line_width
= XFASTINT (box
);
5949 face
->box_color
= face
->foreground
;
5950 face
->box_color_defaulted_p
= 1;
5952 else if (CONSP (box
))
5954 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5955 being one of `raised' or `sunken'. */
5956 face
->box
= FACE_SIMPLE_BOX
;
5957 face
->box_color
= face
->foreground
;
5958 face
->box_color_defaulted_p
= 1;
5959 face
->box_line_width
= 1;
5963 Lisp_Object keyword
, value
;
5965 keyword
= XCAR (box
);
5973 if (EQ (keyword
, QCline_width
))
5975 if (INTEGERP (value
) && XINT (value
) > 0)
5976 face
->box_line_width
= XFASTINT (value
);
5978 else if (EQ (keyword
, QCcolor
))
5980 if (STRINGP (value
))
5982 face
->box_color
= load_color (f
, face
, value
,
5984 face
->use_box_color_for_shadows_p
= 1;
5987 else if (EQ (keyword
, QCstyle
))
5989 if (EQ (value
, Qreleased_button
))
5990 face
->box
= FACE_RAISED_BOX
;
5991 else if (EQ (value
, Qpressed_button
))
5992 face
->box
= FACE_SUNKEN_BOX
;
5997 /* Text underline, overline, strike-through. */
5999 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6001 /* Use default color (same as foreground color). */
6002 face
->underline_p
= 1;
6003 face
->underline_defaulted_p
= 1;
6004 face
->underline_color
= 0;
6006 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6008 /* Use specified color. */
6009 face
->underline_p
= 1;
6010 face
->underline_defaulted_p
= 0;
6011 face
->underline_color
6012 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6013 LFACE_UNDERLINE_INDEX
);
6015 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6017 face
->underline_p
= 0;
6018 face
->underline_defaulted_p
= 0;
6019 face
->underline_color
= 0;
6022 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6023 if (STRINGP (overline
))
6025 face
->overline_color
6026 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6027 LFACE_OVERLINE_INDEX
);
6028 face
->overline_p
= 1;
6030 else if (EQ (overline
, Qt
))
6032 face
->overline_color
= face
->foreground
;
6033 face
->overline_color_defaulted_p
= 1;
6034 face
->overline_p
= 1;
6037 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6038 if (STRINGP (strike_through
))
6040 face
->strike_through_color
6041 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6042 LFACE_STRIKE_THROUGH_INDEX
);
6043 face
->strike_through_p
= 1;
6045 else if (EQ (strike_through
, Qt
))
6047 face
->strike_through_color
= face
->foreground
;
6048 face
->strike_through_color_defaulted_p
= 1;
6049 face
->strike_through_p
= 1;
6052 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6053 if (!NILP (stipple
))
6054 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6057 xassert (face
->fontset
< 0);
6058 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
6060 #endif /* HAVE_X_WINDOWS */
6064 /* Realize the fully-specified face with attributes ATTRS in face
6065 cache C for character set CHARSET or for unibyte text if CHARSET <
6066 0. Do it for TTY frame C->f. Value is a pointer to the newly
6067 created realized face. */
6069 static struct face
*
6070 realize_tty_face (c
, attrs
, charset
)
6071 struct face_cache
*c
;
6078 Lisp_Object tty_defined_color_alist
=
6079 Fsymbol_value (intern ("tty-defined-color-alist"));
6080 Lisp_Object tty_color_alist
= intern ("tty-color-alist");
6082 int face_colors_defaulted
= 0;
6084 /* Frame must be a termcap frame. */
6085 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
6087 /* Allocate a new realized face. */
6088 face
= make_realized_face (attrs
, charset
, Qnil
);
6089 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
6091 /* Map face attributes to TTY appearances. We map slant to
6092 dimmed text because we want italic text to appear differently
6093 and because dimmed text is probably used infrequently. */
6094 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6095 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6097 if (weight
> XLFD_WEIGHT_MEDIUM
)
6098 face
->tty_bold_p
= 1;
6099 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6100 face
->tty_dim_p
= 1;
6101 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6102 face
->tty_underline_p
= 1;
6103 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6104 face
->tty_reverse_p
= 1;
6106 /* Map color names to color indices. */
6107 face
->foreground
= FACE_TTY_DEFAULT_FG_COLOR
;
6108 face
->background
= FACE_TTY_DEFAULT_BG_COLOR
;
6110 XSETFRAME (frame
, c
->f
);
6111 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6113 && XSTRING (color
)->size
6114 && !NILP (tty_defined_color_alist
)
6115 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6117 /* Associations in tty-defined-color-alist are of the form
6118 (NAME INDEX R G B). We need the INDEX part. */
6119 face
->foreground
= XINT (XCAR (XCDR (color
)));
6121 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6122 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6124 face
->foreground
= load_color (c
->f
, face
,
6125 attrs
[LFACE_FOREGROUND_INDEX
],
6126 LFACE_FOREGROUND_INDEX
);
6128 /* If the foreground of the default face is the default color,
6129 use the foreground color defined by the frame. */
6130 if (FRAME_MSDOS_P (c
->f
))
6132 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6133 || face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6135 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
6136 attrs
[LFACE_FOREGROUND_INDEX
] =
6137 msdos_stdcolor_name (face
->foreground
);
6138 face_colors_defaulted
= 1;
6140 else if (face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6142 face
->foreground
= FRAME_BACKGROUND_PIXEL (f
);
6143 attrs
[LFACE_FOREGROUND_INDEX
] =
6144 msdos_stdcolor_name (face
->foreground
);
6145 face_colors_defaulted
= 1;
6151 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6153 && XSTRING (color
)->size
6154 && !NILP (tty_defined_color_alist
)
6155 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6157 /* Associations in tty-defined-color-alist are of the form
6158 (NAME INDEX R G B). We need the INDEX part. */
6159 face
->background
= XINT (XCAR (XCDR (color
)));
6161 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6162 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6164 face
->background
= load_color (c
->f
, face
,
6165 attrs
[LFACE_BACKGROUND_INDEX
],
6166 LFACE_BACKGROUND_INDEX
);
6168 /* If the background of the default face is the default color,
6169 use the background color defined by the frame. */
6170 if (FRAME_MSDOS_P (c
->f
))
6172 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6173 || face
->background
== FACE_TTY_DEFAULT_COLOR
)
6175 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
6176 attrs
[LFACE_BACKGROUND_INDEX
] =
6177 msdos_stdcolor_name (face
->background
);
6178 face_colors_defaulted
= 1;
6180 else if (face
->background
== FACE_TTY_DEFAULT_FG_COLOR
)
6182 face
->background
= FRAME_FOREGROUND_PIXEL (f
);
6183 attrs
[LFACE_BACKGROUND_INDEX
] =
6184 msdos_stdcolor_name (face
->background
);
6185 face_colors_defaulted
= 1;
6191 /* Swap colors if face is inverse-video. If the colors are taken
6192 from the frame colors, they are already inverted, since the
6193 frame-creation function calls x-handle-reverse-video. */
6194 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6196 unsigned long tem
= face
->foreground
;
6198 face
->foreground
= face
->background
;
6199 face
->background
= tem
;
6207 /***********************************************************************
6209 ***********************************************************************/
6211 /* Return the ID of the face to use to display character CH with face
6212 property PROP on frame F in current_buffer. */
6215 compute_char_face (f
, ch
, prop
)
6221 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
6223 : CHAR_CHARSET (ch
));
6226 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
6229 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6230 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6231 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6232 merge_face_vector_with_property (f
, attrs
, prop
);
6233 face_id
= lookup_face (f
, attrs
, charset
);
6240 /* Return the face ID associated with buffer position POS for
6241 displaying ASCII characters. Return in *ENDPTR the position at
6242 which a different face is needed, as far as text properties and
6243 overlays are concerned. W is a window displaying current_buffer.
6245 REGION_BEG, REGION_END delimit the region, so it can be
6248 LIMIT is a position not to scan beyond. That is to limit the time
6249 this function can take.
6251 If MOUSE is non-zero, use the character's mouse-face, not its face.
6253 The face returned is suitable for displaying CHARSET_ASCII if
6254 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
6255 the face is suitable for displaying unibyte text. */
6258 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6259 endptr
, limit
, mouse
)
6262 int region_beg
, region_end
;
6267 struct frame
*f
= XFRAME (w
->frame
);
6268 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6269 Lisp_Object prop
, position
;
6271 Lisp_Object
*overlay_vec
;
6274 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6275 Lisp_Object limit1
, end
;
6276 struct face
*default_face
;
6277 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6279 /* W must display the current buffer. We could write this function
6280 to use the frame and buffer of W, but right now it doesn't. */
6281 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6283 XSETFRAME (frame
, f
);
6284 XSETFASTINT (position
, pos
);
6287 if (pos
< region_beg
&& region_beg
< endpos
)
6288 endpos
= region_beg
;
6290 /* Get the `face' or `mouse_face' text property at POS, and
6291 determine the next position at which the property changes. */
6292 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6293 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6294 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6296 endpos
= XINT (end
);
6298 /* Look at properties from overlays. */
6303 /* First try with room for 40 overlays. */
6305 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6306 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6307 &next_overlay
, NULL
);
6309 /* If there are more than 40, make enough space for all, and try
6311 if (noverlays
> len
)
6314 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6315 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6316 &next_overlay
, NULL
);
6319 if (next_overlay
< endpos
)
6320 endpos
= next_overlay
;
6325 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6327 /* Optimize common cases where we can use the default face. */
6330 && !(pos
>= region_beg
&& pos
< region_end
)
6332 || !FRAME_WINDOW_P (f
)
6333 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6334 return DEFAULT_FACE_ID
;
6336 /* Begin with attributes from the default face. */
6337 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6339 /* Merge in attributes specified via text properties. */
6341 merge_face_vector_with_property (f
, attrs
, prop
);
6343 /* Now merge the overlay data. */
6344 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6345 for (i
= 0; i
< noverlays
; i
++)
6350 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6352 merge_face_vector_with_property (f
, attrs
, prop
);
6354 oend
= OVERLAY_END (overlay_vec
[i
]);
6355 oendpos
= OVERLAY_POSITION (oend
);
6356 if (oendpos
< endpos
)
6360 /* If in the region, merge in the region face. */
6361 if (pos
>= region_beg
&& pos
< region_end
)
6363 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6364 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6366 if (region_end
< endpos
)
6367 endpos
= region_end
;
6372 /* Look up a realized face with the given face attributes,
6373 or realize a new one. Charset is ignored for tty frames. */
6374 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6378 /* Compute the face at character position POS in Lisp string STRING on
6379 window W, for charset CHARSET_ASCII.
6381 If STRING is an overlay string, it comes from position BUFPOS in
6382 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6383 not an overlay string. W must display the current buffer.
6384 REGION_BEG and REGION_END give the start and end positions of the
6385 region; both are -1 if no region is visible. BASE_FACE_ID is the
6386 id of the basic face to merge with. It is usually equal to
6387 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6388 for strings displayed in the mode or top line.
6390 Set *ENDPTR to the next position where to check for faces in
6391 STRING; -1 if the face is constant from POS to the end of the
6394 Value is the id of the face to use. The face returned is suitable
6395 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6396 the face is suitable for displaying unibyte text. */
6399 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6400 region_end
, endptr
, base_face_id
)
6404 int region_beg
, region_end
;
6406 enum face_id base_face_id
;
6408 Lisp_Object prop
, position
, end
, limit
;
6409 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6410 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6411 struct face
*base_face
;
6412 int multibyte_p
= STRING_MULTIBYTE (string
);
6414 /* Get the value of the face property at the current position within
6415 STRING. Value is nil if there is no face property. */
6416 XSETFASTINT (position
, pos
);
6417 prop
= Fget_text_property (position
, Qface
, string
);
6419 /* Get the next position at which to check for faces. Value of end
6420 is nil if face is constant all the way to the end of the string.
6421 Otherwise it is a string position where to check faces next.
6422 Limit is the maximum position up to which to check for property
6423 changes in Fnext_single_property_change. Strings are usually
6424 short, so set the limit to the end of the string. */
6425 XSETFASTINT (limit
, XSTRING (string
)->size
);
6426 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6428 *endptr
= XFASTINT (end
);
6432 base_face
= FACE_FROM_ID (f
, base_face_id
);
6433 xassert (base_face
);
6435 /* Optimize the default case that there is no face property and we
6436 are not in the region. */
6438 && (base_face_id
!= DEFAULT_FACE_ID
6439 /* BUFPOS <= 0 means STRING is not an overlay string, so
6440 that the region doesn't have to be taken into account. */
6442 || bufpos
< region_beg
6443 || bufpos
>= region_end
)
6445 /* We can't realize faces for different charsets differently
6446 if we don't have fonts, so we can stop here if not working
6447 on a window-system frame. */
6448 || !FRAME_WINDOW_P (f
)
6449 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6450 return base_face
->id
;
6452 /* Begin with attributes from the base face. */
6453 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6455 /* Merge in attributes specified via text properties. */
6457 merge_face_vector_with_property (f
, attrs
, prop
);
6459 /* If in the region, merge in the region face. */
6461 && bufpos
>= region_beg
6462 && bufpos
< region_end
)
6464 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6465 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6468 /* Look up a realized face with the given face attributes,
6469 or realize a new one. */
6470 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6475 /***********************************************************************
6477 ***********************************************************************/
6481 /* Print the contents of the realized face FACE to stderr. */
6484 dump_realized_face (face
)
6487 fprintf (stderr
, "ID: %d\n", face
->id
);
6488 #ifdef HAVE_X_WINDOWS
6489 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6491 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6493 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6494 fprintf (stderr
, "background: 0x%lx (%s)\n",
6496 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6497 fprintf (stderr
, "font_name: %s (%s)\n",
6499 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6500 #ifdef HAVE_X_WINDOWS
6501 fprintf (stderr
, "font = %p\n", face
->font
);
6503 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6504 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6505 fprintf (stderr
, "underline: %d (%s)\n",
6507 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6508 fprintf (stderr
, "hash: %d\n", face
->hash
);
6509 fprintf (stderr
, "charset: %d\n", face
->charset
);
6513 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6521 fprintf (stderr
, "font selection order: ");
6522 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6523 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6524 fprintf (stderr
, "\n");
6526 fprintf (stderr
, "alternative fonts: ");
6527 debug_print (Vface_alternative_font_family_alist
);
6528 fprintf (stderr
, "\n");
6530 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6531 Fdump_face (make_number (i
));
6536 CHECK_NUMBER (n
, 0);
6537 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6539 error ("Not a valid face");
6540 dump_realized_face (face
);
6547 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6551 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6552 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6553 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6557 #endif /* GLYPH_DEBUG != 0 */
6561 /***********************************************************************
6563 ***********************************************************************/
6568 Qface
= intern ("face");
6570 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6571 staticpro (&Qbitmap_spec_p
);
6572 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6573 staticpro (&Qframe_update_face_colors
);
6575 /* Lisp face attribute keywords. */
6576 QCfamily
= intern (":family");
6577 staticpro (&QCfamily
);
6578 QCheight
= intern (":height");
6579 staticpro (&QCheight
);
6580 QCweight
= intern (":weight");
6581 staticpro (&QCweight
);
6582 QCslant
= intern (":slant");
6583 staticpro (&QCslant
);
6584 QCunderline
= intern (":underline");
6585 staticpro (&QCunderline
);
6586 QCinverse_video
= intern (":inverse-video");
6587 staticpro (&QCinverse_video
);
6588 QCreverse_video
= intern (":reverse-video");
6589 staticpro (&QCreverse_video
);
6590 QCforeground
= intern (":foreground");
6591 staticpro (&QCforeground
);
6592 QCbackground
= intern (":background");
6593 staticpro (&QCbackground
);
6594 QCstipple
= intern (":stipple");;
6595 staticpro (&QCstipple
);
6596 QCwidth
= intern (":width");
6597 staticpro (&QCwidth
);
6598 QCfont
= intern (":font");
6599 staticpro (&QCfont
);
6600 QCbold
= intern (":bold");
6601 staticpro (&QCbold
);
6602 QCitalic
= intern (":italic");
6603 staticpro (&QCitalic
);
6604 QCoverline
= intern (":overline");
6605 staticpro (&QCoverline
);
6606 QCstrike_through
= intern (":strike-through");
6607 staticpro (&QCstrike_through
);
6608 QCbox
= intern (":box");
6611 /* Symbols used for Lisp face attribute values. */
6612 QCcolor
= intern (":color");
6613 staticpro (&QCcolor
);
6614 QCline_width
= intern (":line-width");
6615 staticpro (&QCline_width
);
6616 QCstyle
= intern (":style");
6617 staticpro (&QCstyle
);
6618 Qreleased_button
= intern ("released-button");
6619 staticpro (&Qreleased_button
);
6620 Qpressed_button
= intern ("pressed-button");
6621 staticpro (&Qpressed_button
);
6622 Qnormal
= intern ("normal");
6623 staticpro (&Qnormal
);
6624 Qultra_light
= intern ("ultra-light");
6625 staticpro (&Qultra_light
);
6626 Qextra_light
= intern ("extra-light");
6627 staticpro (&Qextra_light
);
6628 Qlight
= intern ("light");
6629 staticpro (&Qlight
);
6630 Qsemi_light
= intern ("semi-light");
6631 staticpro (&Qsemi_light
);
6632 Qsemi_bold
= intern ("semi-bold");
6633 staticpro (&Qsemi_bold
);
6634 Qbold
= intern ("bold");
6636 Qextra_bold
= intern ("extra-bold");
6637 staticpro (&Qextra_bold
);
6638 Qultra_bold
= intern ("ultra-bold");
6639 staticpro (&Qultra_bold
);
6640 Qoblique
= intern ("oblique");
6641 staticpro (&Qoblique
);
6642 Qitalic
= intern ("italic");
6643 staticpro (&Qitalic
);
6644 Qreverse_oblique
= intern ("reverse-oblique");
6645 staticpro (&Qreverse_oblique
);
6646 Qreverse_italic
= intern ("reverse-italic");
6647 staticpro (&Qreverse_italic
);
6648 Qultra_condensed
= intern ("ultra-condensed");
6649 staticpro (&Qultra_condensed
);
6650 Qextra_condensed
= intern ("extra-condensed");
6651 staticpro (&Qextra_condensed
);
6652 Qcondensed
= intern ("condensed");
6653 staticpro (&Qcondensed
);
6654 Qsemi_condensed
= intern ("semi-condensed");
6655 staticpro (&Qsemi_condensed
);
6656 Qsemi_expanded
= intern ("semi-expanded");
6657 staticpro (&Qsemi_expanded
);
6658 Qexpanded
= intern ("expanded");
6659 staticpro (&Qexpanded
);
6660 Qextra_expanded
= intern ("extra-expanded");
6661 staticpro (&Qextra_expanded
);
6662 Qultra_expanded
= intern ("ultra-expanded");
6663 staticpro (&Qultra_expanded
);
6664 Qbackground_color
= intern ("background-color");
6665 staticpro (&Qbackground_color
);
6666 Qforeground_color
= intern ("foreground-color");
6667 staticpro (&Qforeground_color
);
6668 Qunspecified
= intern ("unspecified");
6669 staticpro (&Qunspecified
);
6671 Qx_charset_registry
= intern ("x-charset-registry");
6672 staticpro (&Qx_charset_registry
);
6673 Qface_alias
= intern ("face-alias");
6674 staticpro (&Qface_alias
);
6675 Qdefault
= intern ("default");
6676 staticpro (&Qdefault
);
6677 Qtool_bar
= intern ("tool-bar");
6678 staticpro (&Qtool_bar
);
6679 Qregion
= intern ("region");
6680 staticpro (&Qregion
);
6681 Qfringe
= intern ("fringe");
6682 staticpro (&Qfringe
);
6683 Qheader_line
= intern ("header-line");
6684 staticpro (&Qheader_line
);
6685 Qscroll_bar
= intern ("scroll-bar");
6686 staticpro (&Qscroll_bar
);
6687 Qmenu
= intern ("menu");
6689 Qcursor
= intern ("cursor");
6690 staticpro (&Qcursor
);
6691 Qborder
= intern ("border");
6692 staticpro (&Qborder
);
6693 Qmouse
= intern ("mouse");
6694 staticpro (&Qmouse
);
6695 Qtty_color_desc
= intern ("tty-color-desc");
6696 staticpro (&Qtty_color_desc
);
6697 Qtty_color_by_index
= intern ("tty-color-by-index");
6698 staticpro (&Qtty_color_by_index
);
6700 defsubr (&Sinternal_make_lisp_face
);
6701 defsubr (&Sinternal_lisp_face_p
);
6702 defsubr (&Sinternal_set_lisp_face_attribute
);
6703 #ifdef HAVE_X_WINDOWS
6704 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6706 defsubr (&Scolor_gray_p
);
6707 defsubr (&Scolor_supported_p
);
6708 defsubr (&Sinternal_get_lisp_face_attribute
);
6709 defsubr (&Sinternal_lisp_face_attribute_values
);
6710 defsubr (&Sinternal_lisp_face_equal_p
);
6711 defsubr (&Sinternal_lisp_face_empty_p
);
6712 defsubr (&Sinternal_copy_lisp_face
);
6713 defsubr (&Sinternal_merge_in_global_face
);
6714 defsubr (&Sface_font
);
6715 defsubr (&Sframe_face_alist
);
6716 defsubr (&Sinternal_set_font_selection_order
);
6717 defsubr (&Sinternal_set_alternative_font_family_alist
);
6719 defsubr (&Sdump_face
);
6720 defsubr (&Sshow_face_resources
);
6721 #endif /* GLYPH_DEBUG */
6722 defsubr (&Sclear_face_cache
);
6724 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6725 "*Limit for font matching.\n\
6726 If an integer > 0, font matching functions won't load more than\n\
6727 that number of fonts when searching for a matching font.");
6728 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6730 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6731 "List of global face definitions (for internal use only.)");
6732 Vface_new_frame_defaults
= Qnil
;
6734 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6735 "*Default stipple pattern used on monochrome displays.\n\
6736 This stipple pattern is used on monochrome displays\n\
6737 instead of shades of gray for a face background color.\n\
6738 See `set-face-stipple' for possible values for this variable.");
6739 Vface_default_stipple
= build_string ("gray3");
6741 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6742 "Default registry and encoding to use.\n\
6743 This registry and encoding is used for unibyte text. It is set up\n\
6744 from the specified frame font when Emacs starts. (For internal use only.)");
6745 Vface_default_registry
= Qnil
;
6747 DEFVAR_LISP ("face-alternative-font-family-alist",
6748 &Vface_alternative_font_family_alist
, "");
6749 Vface_alternative_font_family_alist
= Qnil
;
6753 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6754 "Allowed scalable fonts.\n\
6755 A value of nil means don't allow any scalable fonts.\n\
6756 A value of t means allow any scalable font.\n\
6757 Otherwise, value must be a list of regular expressions. A font may be\n\
6758 scaled if its name matches a regular expression in the list.");
6759 Vscalable_fonts_allowed
= Qnil
;
6761 #endif /* SCALABLE_FONTS */
6763 #ifdef HAVE_X_WINDOWS
6764 defsubr (&Sbitmap_spec_p
);
6765 defsubr (&Sx_list_fonts
);
6766 defsubr (&Sinternal_face_x_get_resource
);
6767 defsubr (&Sx_family_fonts
);
6768 defsubr (&Sx_font_family_list
);
6769 #endif /* HAVE_X_WINDOWS */