1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
19
20
21
22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
201
202 #include <config.h>
203 #include <stdio.h>
204 #include <sys/types.h>
205 #include <sys/stat.h>
206 #include <stdio.h>
207 #include <setjmp.h>
208
209 #include "lisp.h"
210 #include "character.h"
211 #include "charset.h"
212 #include "keyboard.h"
213 #include "frame.h"
214 #include "termhooks.h"
215
216 #ifdef HAVE_X_WINDOWS
217 #include "xterm.h"
218 #ifdef USE_MOTIF
219 #include <Xm/Xm.h>
220 #include <Xm/XmStrDefs.h>
221 #endif
222 #endif
223
224 #ifdef MSDOS
225 #include "dosfns.h"
226 #endif
227
228 #ifdef WINDOWSNT
229 #include "w32term.h"
230 #include "fontset.h"
231 232
233 #undef FRAME_X_DISPLAY_INFO
234 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
235 #define x_display_info w32_display_info
236 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
237 #define check_x check_w32
238 #define GCGraphicsExposures 0
239 #endif
240
241 #ifdef HAVE_NS
242 #include "nsterm.h"
243 #undef FRAME_X_DISPLAY_INFO
244 #define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
245 #define x_display_info ns_display_info
246 #define FRAME_X_FONT_TABLE FRAME_NS_FONT_TABLE
247 #define check_x check_ns
248 #define GCGraphicsExposures 0
249 #endif
250
251 #include "buffer.h"
252 #include "dispextern.h"
253 #include "blockinput.h"
254 #include "window.h"
255 #include "intervals.h"
256 #include "termchar.h"
257
258 #include "font.h"
259 #ifdef HAVE_WINDOW_SYSTEM
260 #include "fontset.h"
261 #endif
262
263 #ifdef HAVE_X_WINDOWS
264
265 266 267 268
269
270 #ifdef XOS_NEEDS_TIME_H
271 #include <time.h>
272 #undef USG
273 #include <X11/Xos.h>
274 #define USG
275 #define __TIMEVAL__
276 #else
277 #include <X11/Xos.h>
278 #endif
279
280 #endif
281
282 #include <ctype.h>
283
284
285
286 #define PT_PER_INCH 72.27
287
288
289
290 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
291
292
293
294 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), Qignore_defface)
295
296
297
298 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
299
300 301
302
303 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
304
305 306
307
308 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
309
310 311
312
313 #define FACE_CACHE_BUCKETS_SIZE 1001
314
315
316
317 Lisp_Object QCfamily, QCheight, QCweight, QCslant, QCunderline;
318 Lisp_Object QCinverse_video, QCforeground, QCbackground, QCstipple;
319 Lisp_Object QCwidth, QCfont, QCbold, QCitalic;
320 Lisp_Object QCreverse_video;
321 Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
322 Lisp_Object QCfontset;
323
324
325 extern Lisp_Object QCfoundry, QCadstyle, QCregistry;
326 extern Lisp_Object QCspacing, QCsize, QCavgwidth;
327 extern Lisp_Object Qp;
328
329
330
331 Lisp_Object Qnormal, Qbold, Qultra_light, Qextra_light, Qlight;
332 Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
333 Lisp_Object Qoblique, Qitalic, Qreverse_oblique, Qreverse_italic;
334 Lisp_Object Qultra_condensed, Qextra_condensed, Qcondensed;
335 Lisp_Object Qsemi_condensed, Qsemi_expanded, Qexpanded, Qextra_expanded;
336 Lisp_Object Qultra_expanded;
337 Lisp_Object Qreleased_button, Qpressed_button;
338 Lisp_Object QCstyle, QCcolor, QCline_width;
339 Lisp_Object Qunspecified;
340 Lisp_Object Qignore_defface;
341
342 char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg";
343
344 345
346
347 Lisp_Object Qframe_set_background_mode;
348
349
350
351 Lisp_Object Qdefault, Qtool_bar, Qregion, Qfringe;
352 Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu;
353 Lisp_Object Qmode_line_inactive, Qvertical_border;
354 extern Lisp_Object Qmode_line;
355
356 357 358
359
360 Lisp_Object Qface_alias;
361
362 extern Lisp_Object Qcircular_list;
363
364 365 366 367
368
369 Lisp_Object Vface_default_stipple;
370
371 372 373
374
375 Lisp_Object Vface_alternative_font_family_alist;
376
377 378 379
380
381 Lisp_Object Vface_alternative_font_registry_alist;
382
383 384 385 386 387
388
389 Lisp_Object Vscalable_fonts_allowed, Qscalable_fonts_allowed;
390
391
392
393 Lisp_Object Vface_ignored_fonts;
394
395
396
397 Lisp_Object Vface_font_rescale_alist;
398
399 400
401
402 Lisp_Object Vfont_list_limit;
403 #define DEFAULT_FONT_LIST_LIMIT 100
404
405 406 407
408
409 Lisp_Object Qforeground_color, Qbackground_color;
410
411
412
413 Lisp_Object Qface;
414 extern Lisp_Object Qmouse_face;
415
416
417
418 Lisp_Object Qface_no_inherit;
419
420
421
422 Lisp_Object Qbitmap_spec_p;
423
424 425 426 427
428
429 Lisp_Object Vface_new_frame_defaults;
430
431 432 433 434 435 436 437 438 439 440 441 442 443 444
445
446 Lisp_Object Vface_remapping_alist;
447
448
449
450 static int next_lface_id;
451
452
453
454 static Lisp_Object *lface_id_to_name;
455 static int lface_id_to_name_size;
456
457
458
459 Lisp_Object Qtty_color_desc, Qtty_color_by_index, Qtty_color_standard_values;
460
461
462
463 Lisp_Object Qtty_color_alist;
464
465
466
467 Lisp_Object Vtty_defined_color_alist;
468
469 470 471
472
473 static int clear_font_table_count;
474 #define CLEAR_FONT_TABLE_COUNT 100
475 #define CLEAR_FONT_TABLE_NFONTS 10
476
477 478
479
480 int face_change_count;
481
482 483 484 485
486
487 int tty_suppress_bold_inverse_default_colors_p;
488
489 490
491
492 static Lisp_Object Vparam_value_alist;
493
494
495
496 #if GLYPH_DEBUG
497 static int ncolors_allocated;
498 static int npixmaps_allocated;
499 static int ngcs;
500 #endif
501
502 503
504
505 int menu_face_changed_default;
506
507
508
509
510 struct table_entry;
511 struct named_merge_point;
512
513 static void map_tty_color P_ ((struct frame *, struct face *,
514 enum lface_attribute_index, int *));
515 static Lisp_Object resolve_face_name P_ ((Lisp_Object, int));
516 static int may_use_scalable_font_p P_ ((const char *));
517 static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
518 static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *,
519 int, struct named_merge_point *));
520 static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
521 static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
522 static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *));
523 static void free_face_colors P_ ((struct frame *, struct face *));
524 static int face_color_gray_p P_ ((struct frame *, char *));
525 static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *,
526 int));
527 static struct face *realize_non_ascii_face P_ ((struct frame *, Lisp_Object,
528 struct face *));
529 static struct face *realize_x_face P_ ((struct face_cache *, Lisp_Object *));
530 static struct face *realize_tty_face P_ ((struct face_cache *, Lisp_Object *));
531 static int realize_basic_faces P_ ((struct frame *));
532 static int realize_default_face P_ ((struct frame *));
533 static void realize_named_face P_ ((struct frame *, Lisp_Object, int));
534 static int lface_fully_specified_p P_ ((Lisp_Object *));
535 static int lface_equal_p P_ ((Lisp_Object *, Lisp_Object *));
536 static unsigned hash_string_case_insensitive P_ ((Lisp_Object));
537 static unsigned lface_hash P_ ((Lisp_Object *));
538 static int lface_same_font_attributes_p P_ ((Lisp_Object *, Lisp_Object *));
539 static struct face_cache *make_face_cache P_ ((struct frame *));
540 static void clear_face_gcs P_ ((struct face_cache *));
541 static void free_face_cache P_ ((struct face_cache *));
542 static int face_fontset P_ ((Lisp_Object *));
543 static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*,
544 struct named_merge_point *));
545 static int merge_face_ref P_ ((struct frame *, Lisp_Object, Lisp_Object *,
546 int, struct named_merge_point *));
547 static int set_lface_from_font P_ ((struct frame *, Lisp_Object, Lisp_Object,
548 int));
549 static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int));
550 static struct face *make_realized_face P_ ((Lisp_Object *));
551 static void cache_face P_ ((struct face_cache *, struct face *, unsigned));
552 static void uncache_face P_ ((struct face_cache *, struct face *));
553
554 #ifdef HAVE_WINDOW_SYSTEM
555
556 static GC x_create_gc P_ ((struct frame *, unsigned long, XGCValues *));
557 static void x_free_gc P_ ((struct frame *, GC));
558
559 #ifdef USE_X_TOOLKIT
560 static void x_update_menu_appearance P_ ((struct frame *));
561
562 extern void free_frame_menubar P_ ((struct frame *));
563 #endif
564
565 #endif
566
567
568 569 570
571
572 #ifdef HAVE_X_WINDOWS
573
574 #ifdef DEBUG_X_COLORS
575
576 577 578 579 580 581 582 583
584
585
586
587 int color_count[256];
588
589
590
591 void
592 register_color (pixel)
593 unsigned long pixel;
594 {
595 xassert (pixel < 256);
596 ++color_count[pixel];
597 }
598
599
600
601
602 void
603 unregister_color (pixel)
604 unsigned long pixel;
605 {
606 xassert (pixel < 256);
607 if (color_count[pixel] > 0)
608 --color_count[pixel];
609 else
610 abort ();
611 }
612
613
614
615
616 void
617 unregister_colors (pixels, n)
618 unsigned long *pixels;
619 int n;
620 {
621 int i;
622 for (i = 0; i < n; ++i)
623 unregister_color (pixels[i]);
624 }
625
626
627 DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
628 doc: )
629 ()
630 {
631 int i, n;
632
633 fputc ('\n', stderr);
634
635 for (i = n = 0; i < sizeof color_count / sizeof color_count[0]; ++i)
636 if (color_count[i])
637 {
638 fprintf (stderr, "%3d: %5d", i, color_count[i]);
639 ++n;
640 if (n % 5 == 0)
641 fputc ('\n', stderr);
642 else
643 fputc ('\t', stderr);
644 }
645
646 if (n % 5 != 0)
647 fputc ('\n', stderr);
648 return Qnil;
649 }
650
651 #endif
652
653
654 655 656
657
658 void
659 x_free_colors (f, pixels, npixels)
660 struct frame *f;
661 unsigned long *pixels;
662 int npixels;
663 {
664 int class = FRAME_X_DISPLAY_INFO (f)->visual->class;
665
666 667
668 if (class != StaticColor && class != StaticGray && class != TrueColor)
669 {
670 #ifdef DEBUG_X_COLORS
671 unregister_colors (pixels, npixels);
672 #endif
673 XFreeColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
674 pixels, npixels, 0);
675 }
676 }
677
678
679 680 681
682
683 void
684 x_free_dpy_colors (dpy, screen, cmap, pixels, npixels)
685 Display *dpy;
686 Screen *screen;
687 Colormap cmap;
688 unsigned long *pixels;
689 int npixels;
690 {
691 struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
692 int class = dpyinfo->visual->class;
693
694 695
696 if (class != StaticColor && class != StaticGray && class != TrueColor)
697 {
698 #ifdef DEBUG_X_COLORS
699 unregister_colors (pixels, npixels);
700 #endif
701 XFreeColors (dpy, cmap, pixels, npixels, 0);
702 }
703 }
704
705
706 707
708
709 static INLINE GC
710 x_create_gc (f, mask, xgcv)
711 struct frame *f;
712 unsigned long mask;
713 XGCValues *xgcv;
714 {
715 GC gc;
716 BLOCK_INPUT;
717 gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), mask, xgcv);
718 UNBLOCK_INPUT;
719 IF_DEBUG (++ngcs);
720 return gc;
721 }
722
723
724
725
726 static INLINE void
727 x_free_gc (f, gc)
728 struct frame *f;
729 GC gc;
730 {
731 eassert (interrupt_input_blocked);
732 IF_DEBUG (xassert (--ngcs >= 0));
733 XFreeGC (FRAME_X_DISPLAY (f), gc);
734 }
735
736 #endif
737
738 #ifdef WINDOWSNT
739
740
741 static INLINE GC
742 x_create_gc (f, mask, xgcv)
743 struct frame *f;
744 unsigned long mask;
745 XGCValues *xgcv;
746 {
747 GC gc;
748 BLOCK_INPUT;
749 gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, xgcv);
750 UNBLOCK_INPUT;
751 IF_DEBUG (++ngcs);
752 return gc;
753 }
754
755
756
757
758 static INLINE void
759 x_free_gc (f, gc)
760 struct frame *f;
761 GC gc;
762 {
763 IF_DEBUG (xassert (--ngcs >= 0));
764 xfree (gc);
765 }
766
767 #endif
768
769 #ifdef HAVE_NS
770
771
772 static INLINE GC
773 x_create_gc (f, mask, xgcv)
774 struct frame *f;
775 unsigned long mask;
776 XGCValues *xgcv;
777 {
778 GC gc = xmalloc (sizeof (*gc));
779 if (gc)
780 bcopy(xgcv, gc, sizeof(XGCValues));
781 return gc;
782 }
783
784 static INLINE void
785 x_free_gc (f, gc)
786 struct frame *f;
787 GC gc;
788 {
789 xfree (gc);
790 }
791 #endif
792
793 794
795
796 int
797 xstrcasecmp (s1, s2)
798 const unsigned char *s1, *s2;
799 {
800 while (*s1 && *s2)
801 {
802 unsigned char c1 = tolower (*s1);
803 unsigned char c2 = tolower (*s2);
804 if (c1 != c2)
805 return c1 < c2 ? -1 : 1;
806 ++s1, ++s2;
807 }
808
809 if (*s1 == 0)
810 return *s2 == 0 ? 0 : -1;
811 return 1;
812 }
813
814
815 816 817 818 819
820
821 static INLINE struct frame *
822 frame_or_selected_frame (frame, nparam)
823 Lisp_Object frame;
824 int nparam;
825 {
826 if (NILP (frame))
827 frame = selected_frame;
828
829 CHECK_LIVE_FRAME (frame);
830 return XFRAME (frame);
831 }
832
833
834 835 836
837
838
839
840 void
841 init_frame_faces (f)
842 struct frame *f;
843 {
844
845 if (FRAME_FACE_CACHE (f) == NULL)
846 FRAME_FACE_CACHE (f) = make_face_cache (f);
847
848 #ifdef HAVE_WINDOW_SYSTEM
849
850 if (FRAME_WINDOW_P (f))
851 {
852 853 854
855 if (FRAME_IMAGE_CACHE (f) == NULL)
856 FRAME_IMAGE_CACHE (f) = make_image_cache ();
857 ++FRAME_IMAGE_CACHE (f)->refcount;
858 }
859 #endif
860
861 862
863 #ifdef HAVE_X_WINDOWS
864 if (!FRAME_X_P (f) || FRAME_X_WINDOW (f))
865 #endif
866 #ifdef WINDOWSNT
867 if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
868 #endif
869 #ifdef HAVE_NS
870 if (!FRAME_NS_P (f) || FRAME_NS_WINDOW (f))
871 #endif
872 if (!realize_basic_faces (f))
873 abort ();
874 }
875
876
877
878
879 void
880 free_frame_faces (f)
881 struct frame *f;
882 {
883 struct face_cache *face_cache = FRAME_FACE_CACHE (f);
884
885 if (face_cache)
886 {
887 free_face_cache (face_cache);
888 FRAME_FACE_CACHE (f) = NULL;
889 }
890
891 #ifdef HAVE_WINDOW_SYSTEM
892 if (FRAME_WINDOW_P (f))
893 {
894 struct image_cache *image_cache = FRAME_IMAGE_CACHE (f);
895 if (image_cache)
896 {
897 --image_cache->refcount;
898 if (image_cache->refcount == 0)
899 free_image_cache (f);
900 }
901 }
902 #endif
903 }
904
905
906 907 908 909
910
911 void
912 recompute_basic_faces (f)
913 struct frame *f;
914 {
915 if (FRAME_FACE_CACHE (f))
916 {
917 clear_face_cache (0);
918 if (!realize_basic_faces (f))
919 abort ();
920 }
921 }
922
923
924 925
926
927 void
928 clear_face_cache (clear_fonts_p)
929 int clear_fonts_p;
930 {
931 #ifdef HAVE_WINDOW_SYSTEM
932 Lisp_Object tail, frame;
933 struct frame *f;
934
935 if (clear_fonts_p
936 || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
937 {
938 #if 0
939
940 clear_font_cache (frame);
941 #endif
942
943 944 945
946 clear_font_table_count = 0;
947
948 FOR_EACH_FRAME (tail, frame)
949 {
950 struct frame *f = XFRAME (frame);
951 if (FRAME_WINDOW_P (f)
952 && FRAME_X_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS)
953 free_all_realized_faces (frame);
954 }
955 }
956 else
957 {
958
959 FOR_EACH_FRAME (tail, frame)
960 {
961 f = XFRAME (frame);
962 if (FRAME_WINDOW_P (f))
963 clear_face_gcs (FRAME_FACE_CACHE (f));
964 }
965 clear_image_caches (Qnil);
966 }
967 #endif
968 }
969
970
971 DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
972 doc: 973 )
974 (thoroughly)
975 Lisp_Object thoroughly;
976 {
977 clear_face_cache (!NILP (thoroughly));
978 ++face_change_count;
979 ++windows_or_buffers_changed;
980 return Qnil;
981 }
982
983
984 985 986
987
988 #ifdef HAVE_WINDOW_SYSTEM
989
990 DEFUN ("bitmap-spec-p", Fbitmap_spec_p, Sbitmap_spec_p, 1, 1, 0,
991 doc: 992 993 994 995 996 )
997 (object)
998 Lisp_Object object;
999 {
1000 int pixmap_p = 0;
1001
1002 if (STRINGP (object))
1003
1004 pixmap_p = 1;
1005 else if (CONSP (object))
1006 {
1007 1008 1009
1010 Lisp_Object width, height, data;
1011
1012 height = width = data = Qnil;
1013
1014 if (CONSP (object))
1015 {
1016 width = XCAR (object);
1017 object = XCDR (object);
1018 if (CONSP (object))
1019 {
1020 height = XCAR (object);
1021 object = XCDR (object);
1022 if (CONSP (object))
1023 data = XCAR (object);
1024 }
1025 }
1026
1027 if (NATNUMP (width) && NATNUMP (height) && STRINGP (data))
1028 {
1029 int bytes_per_row = ((XFASTINT (width) + BITS_PER_CHAR - 1)
1030 / BITS_PER_CHAR);
1031 if (SBYTES (data) >= bytes_per_row * XINT (height))
1032 pixmap_p = 1;
1033 }
1034 }
1035
1036 return pixmap_p ? Qt : Qnil;
1037 }
1038
1039
1040 1041 1042 1043 1044 1045
1046
1047 static int
1048 load_pixmap (f, name, w_ptr, h_ptr)
1049 FRAME_PTR f;
1050 Lisp_Object name;
1051 unsigned int *w_ptr, *h_ptr;
1052 {
1053 int bitmap_id;
1054
1055 if (NILP (name))
1056 return 0;
1057
1058 CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name);
1059
1060 BLOCK_INPUT;
1061 if (CONSP (name))
1062 {
1063
1064
1065 int h, w;
1066 Lisp_Object bits;
1067
1068 w = XINT (Fcar (name));
1069 h = XINT (Fcar (Fcdr (name)));
1070 bits = Fcar (Fcdr (Fcdr (name)));
1071
1072 bitmap_id = x_create_bitmap_from_data (f, SDATA (bits),
1073 w, h);
1074 }
1075 else
1076 {
1077
1078 bitmap_id = x_create_bitmap_from_file (f, name);
1079 }
1080 UNBLOCK_INPUT;
1081
1082 if (bitmap_id < 0)
1083 {
1084 add_to_log ("Invalid or undefined bitmap `%s'", name, Qnil);
1085 bitmap_id = 0;
1086
1087 if (w_ptr)
1088 *w_ptr = 0;
1089 if (h_ptr)
1090 *h_ptr = 0;
1091 }
1092 else
1093 {
1094 #if GLYPH_DEBUG
1095 ++npixmaps_allocated;
1096 #endif
1097 if (w_ptr)
1098 *w_ptr = x_bitmap_width (f, bitmap_id);
1099
1100 if (h_ptr)
1101 *h_ptr = x_bitmap_height (f, bitmap_id);
1102 }
1103
1104 return bitmap_id;
1105 }
1106
1107 #endif
1108
1109
1110
1111 1112 1113
1114
1115 1116 1117
1118
1119 static int
1120 parse_rgb_list (rgb_list, color)
1121 Lisp_Object rgb_list;
1122 XColor *color;
1123 {
1124 #define PARSE_RGB_LIST_FIELD(field) \
1125 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1126 { \
1127 color->field = XINT (XCAR (rgb_list)); \
1128 rgb_list = XCDR (rgb_list); \
1129 } \
1130 else \
1131 return 0;
1132
1133 PARSE_RGB_LIST_FIELD (red);
1134 PARSE_RGB_LIST_FIELD (green);
1135 PARSE_RGB_LIST_FIELD (blue);
1136
1137 return 1;
1138 }
1139
1140
1141 1142 1143 1144
1145
1146 static int
1147 tty_lookup_color (f, color, tty_color, std_color)
1148 struct frame *f;
1149 Lisp_Object color;
1150 XColor *tty_color, *std_color;
1151 {
1152 Lisp_Object frame, color_desc;
1153
1154 if (!STRINGP (color) || NILP (Ffboundp (Qtty_color_desc)))
1155 return 0;
1156
1157 XSETFRAME (frame, f);
1158
1159 color_desc = call2 (Qtty_color_desc, color, frame);
1160 if (CONSP (color_desc) && CONSP (XCDR (color_desc)))
1161 {
1162 Lisp_Object rgb;
1163
1164 if (! INTEGERP (XCAR (XCDR (color_desc))))
1165 return 0;
1166
1167 tty_color->pixel = XINT (XCAR (XCDR (color_desc)));
1168
1169 rgb = XCDR (XCDR (color_desc));
1170 if (! parse_rgb_list (rgb, tty_color))
1171 return 0;
1172
1173
1174 if (std_color)
1175 {
1176
1177 *std_color = *tty_color;
1178
1179 1180 1181 1182
1183 if ((!STRINGP (XCAR (color_desc))
1184 || NILP (Fstring_equal (color, XCAR (color_desc))))
1185 && !NILP (Ffboundp (Qtty_color_standard_values)))
1186 {
1187
1188 rgb = call1 (Qtty_color_standard_values, color);
1189 if (! parse_rgb_list (rgb, std_color))
1190 return 0;
1191 }
1192 }
1193
1194 return 1;
1195 }
1196 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1197 1198 1199 1200
1201 return 1;
1202 else
1203
1204 return 0;
1205 }
1206
1207
1208
1209 int
1210 tty_defined_color (f, color_name, color_def, alloc)
1211 struct frame *f;
1212 char *color_name;
1213 XColor *color_def;
1214 int alloc;
1215 {
1216 int status = 1;
1217
1218
1219 color_def->pixel = FACE_TTY_DEFAULT_COLOR;
1220 color_def->red = 0;
1221 color_def->blue = 0;
1222 color_def->green = 0;
1223
1224 if (*color_name)
1225 status = tty_lookup_color (f, build_string (color_name), color_def, NULL);
1226
1227 if (color_def->pixel == FACE_TTY_DEFAULT_COLOR && *color_name)
1228 {
1229 if (strcmp (color_name, "unspecified-fg") == 0)
1230 color_def->pixel = FACE_TTY_DEFAULT_FG_COLOR;
1231 else if (strcmp (color_name, "unspecified-bg") == 0)
1232 color_def->pixel = FACE_TTY_DEFAULT_BG_COLOR;
1233 }
1234
1235 if (color_def->pixel != FACE_TTY_DEFAULT_COLOR)
1236 status = 1;
1237
1238 return status;
1239 }
1240
1241
1242 1243 1244 1245 1246
1247
1248 int
1249 defined_color (f, color_name, color_def, alloc)
1250 struct frame *f;
1251 char *color_name;
1252 XColor *color_def;
1253 int alloc;
1254 {
1255 if (!FRAME_WINDOW_P (f))
1256 return tty_defined_color (f, color_name, color_def, alloc);
1257 #ifdef HAVE_X_WINDOWS
1258 else if (FRAME_X_P (f))
1259 return x_defined_color (f, color_name, color_def, alloc);
1260 #endif
1261 #ifdef WINDOWSNT
1262 else if (FRAME_W32_P (f))
1263 return w32_defined_color (f, color_name, color_def, alloc);
1264 #endif
1265 #ifdef HAVE_NS
1266 else if (FRAME_NS_P (f))
1267 return ns_defined_color (f, color_name, color_def, alloc, 1);
1268 #endif
1269 else
1270 abort ();
1271 }
1272
1273
1274 1275
1276
1277 Lisp_Object
1278 tty_color_name (f, idx)
1279 struct frame *f;
1280 int idx;
1281 {
1282 if (idx >= 0 && !NILP (Ffboundp (Qtty_color_by_index)))
1283 {
1284 Lisp_Object frame;
1285 Lisp_Object coldesc;
1286
1287 XSETFRAME (frame, f);
1288 coldesc = call2 (Qtty_color_by_index, make_number (idx), frame);
1289
1290 if (!NILP (coldesc))
1291 return XCAR (coldesc);
1292 }
1293 #ifdef MSDOS
1294 1295
1296 if (FRAME_MSDOS_P (f) && !inhibit_window_system)
1297 return msdos_stdcolor_name (idx);
1298 #endif
1299
1300 if (idx == FACE_TTY_DEFAULT_FG_COLOR)
1301 return build_string (unspecified_fg);
1302 if (idx == FACE_TTY_DEFAULT_BG_COLOR)
1303 return build_string (unspecified_bg);
1304
1305 return Qunspecified;
1306 }
1307
1308
1309 1310 1311 1312
1313
1314 static int
1315 face_color_gray_p (f, color_name)
1316 struct frame *f;
1317 char *color_name;
1318 {
1319 XColor color;
1320 int gray_p;
1321
1322 if (defined_color (f, color_name, &color, 0))
1323 gray_p = (
1324 (color.red < 5000 && color.green < 5000 && color.blue < 5000)
1325 ||
1326 ((eabs (color.red - color.green)
1327 < max (color.red, color.green) / 20)
1328 && (eabs (color.green - color.blue)
1329 < max (color.green, color.blue) / 20)
1330 && (eabs (color.blue - color.red)
1331 < max (color.blue, color.red) / 20)));
1332 else
1333 gray_p = 0;
1334
1335 return gray_p;
1336 }
1337
1338
1339 1340 1341
1342
1343 static int
1344 face_color_supported_p (f, color_name, background_p)
1345 struct frame *f;
1346 char *color_name;
1347 int background_p;
1348 {
1349 Lisp_Object frame;
1350 XColor not_used;
1351
1352 XSETFRAME (frame, f);
1353 return
1354 #ifdef HAVE_WINDOW_SYSTEM
1355 FRAME_WINDOW_P (f)
1356 ? (!NILP (Fxw_display_color_p (frame))
1357 || xstrcasecmp (color_name, "black") == 0
1358 || xstrcasecmp (color_name, "white") == 0
1359 || (background_p
1360 && face_color_gray_p (f, color_name))
1361 || (!NILP (Fx_display_grayscale_p (frame))
1362 && face_color_gray_p (f, color_name)))
1363 :
1364 #endif
1365 tty_defined_color (f, color_name, ¬_used, 0);
1366 }
1367
1368
1369 DEFUN ("color-gray-p", Fcolor_gray_p, Scolor_gray_p, 1, 2, 0,
1370 doc: 1371 1372 )
1373 (color, frame)
1374 Lisp_Object color, frame;
1375 {
1376 struct frame *f;
1377
1378 CHECK_STRING (color);
1379 if (NILP (frame))
1380 frame = selected_frame;
1381 else
1382 CHECK_FRAME (frame);
1383 f = XFRAME (frame);
1384 return face_color_gray_p (f, SDATA (color)) ? Qt : Qnil;
1385 }
1386
1387
1388 DEFUN ("color-supported-p", Fcolor_supported_p,
1389 Scolor_supported_p, 1, 3, 0,
1390 doc: 1391 1392 1393 1394 )
1395 (color, frame, background_p)
1396 Lisp_Object frame, color, background_p;
1397 {
1398 struct frame *f;
1399
1400 CHECK_STRING (color);
1401 if (NILP (frame))
1402 frame = selected_frame;
1403 else
1404 CHECK_FRAME (frame);
1405 f = XFRAME (frame);
1406 if (face_color_supported_p (f, SDATA (color), !NILP (background_p)))
1407 return Qt;
1408 return Qnil;
1409 }
1410
1411
1412 1413 1414 1415 1416 1417 1418 1419
1420
1421 unsigned long
1422 load_color (f, face, name, target_index)
1423 struct frame *f;
1424 struct face *face;
1425 Lisp_Object name;
1426 enum lface_attribute_index target_index;
1427 {
1428 XColor color;
1429
1430 xassert (STRINGP (name));
1431 xassert (target_index == LFACE_FOREGROUND_INDEX
1432 || target_index == LFACE_BACKGROUND_INDEX
1433 || target_index == LFACE_UNDERLINE_INDEX
1434 || target_index == LFACE_OVERLINE_INDEX
1435 || target_index == LFACE_STRIKE_THROUGH_INDEX
1436 || target_index == LFACE_BOX_INDEX);
1437
1438 1439
1440 if (!defined_color (f, SDATA (name), &color, 1))
1441 {
1442 add_to_log ("Unable to load color \"%s\"", name, Qnil);
1443
1444 switch (target_index)
1445 {
1446 case LFACE_FOREGROUND_INDEX:
1447 face->foreground_defaulted_p = 1;
1448 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1449 break;
1450
1451 case LFACE_BACKGROUND_INDEX:
1452 face->background_defaulted_p = 1;
1453 color.pixel = FRAME_BACKGROUND_PIXEL (f);
1454 break;
1455
1456 case LFACE_UNDERLINE_INDEX:
1457 face->underline_defaulted_p = 1;
1458 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1459 break;
1460
1461 case LFACE_OVERLINE_INDEX:
1462 face->overline_color_defaulted_p = 1;
1463 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1464 break;
1465
1466 case LFACE_STRIKE_THROUGH_INDEX:
1467 face->strike_through_color_defaulted_p = 1;
1468 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1469 break;
1470
1471 case LFACE_BOX_INDEX:
1472 face->box_color_defaulted_p = 1;
1473 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1474 break;
1475
1476 default:
1477 abort ();
1478 }
1479 }
1480 #if GLYPH_DEBUG
1481 else
1482 ++ncolors_allocated;
1483 #endif
1484
1485 return color.pixel;
1486 }
1487
1488
1489 #ifdef HAVE_WINDOW_SYSTEM
1490
1491 1492 1493 1494
1495
1496 static void
1497 load_face_colors (f, face, attrs)
1498 struct frame *f;
1499 struct face *face;
1500 Lisp_Object *attrs;
1501 {
1502 Lisp_Object fg, bg;
1503
1504 bg = attrs[LFACE_BACKGROUND_INDEX];
1505 fg = attrs[LFACE_FOREGROUND_INDEX];
1506
1507
1508 if (EQ (attrs[LFACE_INVERSE_INDEX], Qt))
1509 {
1510 Lisp_Object tmp;
1511 tmp = fg;
1512 fg = bg;
1513 bg = tmp;
1514 }
1515
1516 1517 1518 1519
1520 if (!face_color_supported_p (f, SDATA (bg), 0)
1521 && !NILP (Fbitmap_spec_p (Vface_default_stipple)))
1522 {
1523 x_destroy_bitmap (f, face->stipple);
1524 face->stipple = load_pixmap (f, Vface_default_stipple,
1525 &face->pixmap_w, &face->pixmap_h);
1526 }
1527
1528 face->background = load_color (f, face, bg, LFACE_BACKGROUND_INDEX);
1529 face->foreground = load_color (f, face, fg, LFACE_FOREGROUND_INDEX);
1530 }
1531
1532
1533
1534
1535 void
1536 unload_color (f, pixel)
1537 struct frame *f;
1538 unsigned long pixel;
1539 {
1540 #ifdef HAVE_X_WINDOWS
1541 if (pixel != -1)
1542 {
1543 BLOCK_INPUT;
1544 x_free_colors (f, &pixel, 1);
1545 UNBLOCK_INPUT;
1546 }
1547 #endif
1548 }
1549
1550
1551
1552
1553 static void
1554 free_face_colors (f, face)
1555 struct frame *f;
1556 struct face *face;
1557 {
1558
1559 #ifdef HAVE_X_WINDOWS
1560 if (face->colors_copied_bitwise_p)
1561 return;
1562
1563 BLOCK_INPUT;
1564
1565 if (!face->foreground_defaulted_p)
1566 {
1567 x_free_colors (f, &face->foreground, 1);
1568 IF_DEBUG (--ncolors_allocated);
1569 }
1570
1571 if (!face->background_defaulted_p)
1572 {
1573 x_free_colors (f, &face->background, 1);
1574 IF_DEBUG (--ncolors_allocated);
1575 }
1576
1577 if (face->underline_p
1578 && !face->underline_defaulted_p)
1579 {
1580 x_free_colors (f, &face->underline_color, 1);
1581 IF_DEBUG (--ncolors_allocated);
1582 }
1583
1584 if (face->overline_p
1585 && !face->overline_color_defaulted_p)
1586 {
1587 x_free_colors (f, &face->overline_color, 1);
1588 IF_DEBUG (--ncolors_allocated);
1589 }
1590
1591 if (face->strike_through_p
1592 && !face->strike_through_color_defaulted_p)
1593 {
1594 x_free_colors (f, &face->strike_through_color, 1);
1595 IF_DEBUG (--ncolors_allocated);
1596 }
1597
1598 if (face->box != FACE_NO_BOX
1599 && !face->box_color_defaulted_p)
1600 {
1601 x_free_colors (f, &face->box_color, 1);
1602 IF_DEBUG (--ncolors_allocated);
1603 }
1604
1605 UNBLOCK_INPUT;
1606 #endif
1607 }
1608
1609 #endif
1610
1611
1612
1613 1614 1615
1616
1617
1618
1619 enum xlfd_field
1620 {
1621 XLFD_FOUNDRY,
1622 XLFD_FAMILY,
1623 XLFD_WEIGHT,
1624 XLFD_SLANT,
1625 XLFD_SWIDTH,
1626 XLFD_ADSTYLE,
1627 XLFD_PIXEL_SIZE,
1628 XLFD_POINT_SIZE,
1629 XLFD_RESX,
1630 XLFD_RESY,
1631 XLFD_SPACING,
1632 XLFD_AVGWIDTH,
1633 XLFD_REGISTRY,
1634 XLFD_ENCODING,
1635 XLFD_LAST
1636 };
1637
1638 1639
1640
1641 enum xlfd_slant
1642 {
1643 XLFD_SLANT_UNKNOWN,
1644 XLFD_SLANT_ROMAN,
1645 XLFD_SLANT_ITALIC,
1646 XLFD_SLANT_OBLIQUE,
1647 XLFD_SLANT_REVERSE_ITALIC,
1648 XLFD_SLANT_REVERSE_OBLIQUE,
1649 XLFD_SLANT_OTHER
1650 };
1651
1652
1653
1654 enum xlfd_weight
1655 {
1656 XLFD_WEIGHT_UNKNOWN,
1657 XLFD_WEIGHT_ULTRA_LIGHT,
1658 XLFD_WEIGHT_EXTRA_LIGHT,
1659 XLFD_WEIGHT_LIGHT,
1660 XLFD_WEIGHT_SEMI_LIGHT,
1661 XLFD_WEIGHT_MEDIUM,
1662 XLFD_WEIGHT_SEMI_BOLD,
1663 XLFD_WEIGHT_BOLD,
1664 XLFD_WEIGHT_EXTRA_BOLD,
1665 XLFD_WEIGHT_ULTRA_BOLD
1666 };
1667
1668
1669
1670 enum xlfd_swidth
1671 {
1672 XLFD_SWIDTH_UNKNOWN,
1673 XLFD_SWIDTH_ULTRA_CONDENSED,
1674 XLFD_SWIDTH_EXTRA_CONDENSED,
1675 XLFD_SWIDTH_CONDENSED,
1676 XLFD_SWIDTH_SEMI_CONDENSED,
1677 XLFD_SWIDTH_MEDIUM,
1678 XLFD_SWIDTH_SEMI_EXPANDED,
1679 XLFD_SWIDTH_EXPANDED,
1680 XLFD_SWIDTH_EXTRA_EXPANDED,
1681 XLFD_SWIDTH_ULTRA_EXPANDED
1682 };
1683
1684 1685 1686 1687
1688
1689 static int font_sort_order[4];
1690
1691 #ifdef HAVE_WINDOW_SYSTEM
1692
1693 static enum font_property_index font_props_for_sorting[FONT_SIZE_INDEX];
1694
1695 static int
1696 compare_fonts_by_sort_order (v1, v2)
1697 const void *v1, *v2;
1698 {
1699 Lisp_Object font1 = *(Lisp_Object *) v1;
1700 Lisp_Object font2 = *(Lisp_Object *) v2;
1701 int i;
1702
1703 for (i = 0; i < FONT_SIZE_INDEX; i++)
1704 {
1705 enum font_property_index idx = font_props_for_sorting[i];
1706 Lisp_Object val1 = AREF (font1, idx), val2 = AREF (font2, idx);
1707 int result;
1708
1709 if (idx <= FONT_REGISTRY_INDEX)
1710 {
1711 if (STRINGP (val1))
1712 result = STRINGP (val2) ? strcmp (SDATA (val1), SDATA (val2)) : -1;
1713 else
1714 result = STRINGP (val2) ? 1 : 0;
1715 }
1716 else
1717 {
1718 if (INTEGERP (val1))
1719 result = INTEGERP (val2) ? XINT (val1) - XINT (val2) : -1;
1720 else
1721 result = INTEGERP (val2) ? 1 : 0;
1722 }
1723 if (result)
1724 return result;
1725 }
1726 return 0;
1727 }
1728
1729 DEFUN ("x-family-fonts", Fx_family_fonts, Sx_family_fonts, 0, 2, 0,
1730 doc: 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 )
1745 (family, frame)
1746 Lisp_Object family, frame;
1747 {
1748 Lisp_Object font_spec, list, *drivers, vec;
1749 int i, nfonts, ndrivers;
1750 Lisp_Object result;
1751
1752 if (NILP (frame))
1753 frame = selected_frame;
1754 CHECK_LIVE_FRAME (frame);
1755
1756 font_spec = Ffont_spec (0, NULL);
1757 if (!NILP (family))
1758 {
1759 CHECK_STRING (family);
1760 font_parse_family_registry (family, Qnil, font_spec);
1761 }
1762
1763 list = font_list_entities (frame, font_spec);
1764 if (NILP (list))
1765 return Qnil;
1766
1767
1768 for (i = 0; i < 4; i++)
1769 switch (font_sort_order[i])
1770 {
1771 case XLFD_SWIDTH:
1772 font_props_for_sorting[i] = FONT_WIDTH_INDEX; break;
1773 case XLFD_POINT_SIZE:
1774 font_props_for_sorting[i] = FONT_SIZE_INDEX; break;
1775 case XLFD_WEIGHT:
1776 font_props_for_sorting[i] = FONT_WEIGHT_INDEX; break;
1777 default:
1778 font_props_for_sorting[i] = FONT_SLANT_INDEX; break;
1779 }
1780 font_props_for_sorting[i++] = FONT_FAMILY_INDEX;
1781 font_props_for_sorting[i++] = FONT_FOUNDRY_INDEX;
1782 font_props_for_sorting[i++] = FONT_ADSTYLE_INDEX;
1783 font_props_for_sorting[i++] = FONT_REGISTRY_INDEX;
1784
1785 ndrivers = XINT (Flength (list));
1786 drivers = alloca (sizeof (Lisp_Object) * ndrivers);
1787 for (i = 0; i < ndrivers; i++, list = XCDR (list))
1788 drivers[i] = XCAR (list);
1789 vec = Fvconcat (ndrivers, drivers);
1790 nfonts = ASIZE (vec);
1791
1792 qsort (XVECTOR (vec)->contents, nfonts, sizeof (Lisp_Object),
1793 compare_fonts_by_sort_order);
1794
1795 result = Qnil;
1796 for (i = nfonts - 1; i >= 0; --i)
1797 {
1798 Lisp_Object font = AREF (vec, i);
1799 Lisp_Object v = Fmake_vector (make_number (8), Qnil);
1800 int point;
1801 Lisp_Object spacing;
1802
1803 ASET (v, 0, AREF (font, FONT_FAMILY_INDEX));
1804 ASET (v, 1, FONT_WIDTH_SYMBOLIC (font));
1805 point = PIXEL_TO_POINT (XINT (AREF (font, FONT_SIZE_INDEX)) * 10,
1806 XFRAME (frame)->resy);
1807 ASET (v, 2, make_number (point));
1808 ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font));
1809 ASET (v, 4, FONT_SLANT_SYMBOLIC (font));
1810 spacing = Ffont_get (font, QCspacing);
1811 ASET (v, 5, (NILP (spacing) || EQ (spacing, Qp)) ? Qnil : Qt);
1812 ASET (v, 6, Ffont_xlfd_name (font, Qnil));
1813 ASET (v, 7, AREF (font, FONT_REGISTRY_INDEX));
1814
1815 result = Fcons (v, result);
1816 }
1817
1818 return result;
1819 }
1820
1821 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 5, 0,
1822 doc: 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 )
1843 (pattern, face, frame, maximum, width)
1844 Lisp_Object pattern, face, frame, maximum, width;
1845 {
1846 struct frame *f;
1847 int size, avgwidth;
1848
1849 check_x ();
1850 CHECK_STRING (pattern);
1851
1852 if (! NILP (maximum))
1853 CHECK_NATNUM (maximum);
1854
1855 if (!NILP (width))
1856 CHECK_NUMBER (width);
1857
1858 1859
1860 if (NILP (frame))
1861 frame = selected_frame;
1862 f = frame_or_selected_frame (frame, 2);
1863 if (! FRAME_WINDOW_P (f))
1864 {
1865
1866 f = NULL;
1867 frame = Qnil;
1868 face = Qnil;
1869 }
1870
1871
1872
1873 if (NILP (face))
1874 size = 0;
1875 else
1876 {
1877 1878
1879 int face_id = lookup_named_face (f, face, 0);
1880 struct face *face = (face_id < 0
1881 ? NULL
1882 : FACE_FROM_ID (f, face_id));
1883
1884 if (face && face->font)
1885 {
1886 size = face->font->pixel_size;
1887 avgwidth = face->font->average_width;
1888 }
1889 else
1890 {
1891 size = FRAME_FONT (f)->pixel_size;
1892 avgwidth = FRAME_FONT (f)->average_width;
1893 }
1894 if (!NILP (width))
1895 avgwidth *= XINT (width);
1896 }
1897
1898 {
1899 Lisp_Object font_spec;
1900 Lisp_Object args[2], tail;
1901
1902 font_spec = font_spec_from_name (pattern);
1903 if (!FONTP (font_spec))
1904 signal_error ("Invalid font name", pattern);
1905
1906 if (size)
1907 {
1908 Ffont_put (font_spec, QCsize, make_number (size));
1909 Ffont_put (font_spec, QCavgwidth, make_number (avgwidth));
1910 }
1911 args[0] = Flist_fonts (font_spec, frame, maximum, font_spec);
1912 for (tail = args[0]; CONSP (tail); tail = XCDR (tail))
1913 {
1914 Lisp_Object font_entity;
1915
1916 font_entity = XCAR (tail);
1917 if ((NILP (AREF (font_entity, FONT_SIZE_INDEX))
1918 || XINT (AREF (font_entity, FONT_SIZE_INDEX)) == 0)
1919 && ! NILP (AREF (font_spec, FONT_SIZE_INDEX)))
1920 {
1921 1922
1923 font_entity = Fcopy_font_spec (font_entity);
1924 ASET (font_entity, FONT_SIZE_INDEX,
1925 AREF (font_spec, FONT_SIZE_INDEX));
1926 }
1927 XSETCAR (tail, Ffont_xlfd_name (font_entity, Qnil));
1928 }
1929 if (NILP (frame))
1930
1931 return args[0];
1932 args[1] = list_fontsets (f, pattern, size);
1933 return Fnconc (2, args);
1934 }
1935 }
1936
1937 #endif
1938
1939
1940 1941 1942
1943
1944
1945
1946 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1947 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1948 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1949 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1950 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1951 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1952 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1953 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1954 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1955 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1956 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1957 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1958 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1959 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1960 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1961 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1962 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1963
1964 1965
1966
1967 #define LFACEP(LFACE) \
1968 (VECTORP (LFACE) \
1969 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
1970 && EQ (AREF (LFACE, 0), Qface))
1971
1972
1973 #if GLYPH_DEBUG
1974
1975
1976
1977 static void
1978 check_lface_attrs (attrs)
1979 Lisp_Object *attrs;
1980 {
1981 xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
1982 || IGNORE_DEFFACE_P (attrs[LFACE_FAMILY_INDEX])
1983 || STRINGP (attrs[LFACE_FAMILY_INDEX]));
1984 xassert (UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
1985 || IGNORE_DEFFACE_P (attrs[LFACE_FOUNDRY_INDEX])
1986 || STRINGP (attrs[LFACE_FOUNDRY_INDEX]));
1987 xassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
1988 || IGNORE_DEFFACE_P (attrs[LFACE_SWIDTH_INDEX])
1989 || SYMBOLP (attrs[LFACE_SWIDTH_INDEX]));
1990 xassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
1991 || IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX])
1992 || INTEGERP (attrs[LFACE_HEIGHT_INDEX])
1993 || FLOATP (attrs[LFACE_HEIGHT_INDEX])
1994 || FUNCTIONP (attrs[LFACE_HEIGHT_INDEX]));
1995 xassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
1996 || IGNORE_DEFFACE_P (attrs[LFACE_WEIGHT_INDEX])
1997 || SYMBOLP (attrs[LFACE_WEIGHT_INDEX]));
1998 xassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
1999 || IGNORE_DEFFACE_P (attrs[LFACE_SLANT_INDEX])
2000 || SYMBOLP (attrs[LFACE_SLANT_INDEX]));
2001 xassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
2002 || IGNORE_DEFFACE_P (attrs[LFACE_UNDERLINE_INDEX])
2003 || SYMBOLP (attrs[LFACE_UNDERLINE_INDEX])
2004 || STRINGP (attrs[LFACE_UNDERLINE_INDEX]));
2005 xassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
2006 || IGNORE_DEFFACE_P (attrs[LFACE_OVERLINE_INDEX])
2007 || SYMBOLP (attrs[LFACE_OVERLINE_INDEX])
2008 || STRINGP (attrs[LFACE_OVERLINE_INDEX]));
2009 xassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
2010 || IGNORE_DEFFACE_P (attrs[LFACE_STRIKE_THROUGH_INDEX])
2011 || SYMBOLP (attrs[LFACE_STRIKE_THROUGH_INDEX])
2012 || STRINGP (attrs[LFACE_STRIKE_THROUGH_INDEX]));
2013 xassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
2014 || IGNORE_DEFFACE_P (attrs[LFACE_BOX_INDEX])
2015 || SYMBOLP (attrs[LFACE_BOX_INDEX])
2016 || STRINGP (attrs[LFACE_BOX_INDEX])
2017 || INTEGERP (attrs[LFACE_BOX_INDEX])
2018 || CONSP (attrs[LFACE_BOX_INDEX]));
2019 xassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
2020 || IGNORE_DEFFACE_P (attrs[LFACE_INVERSE_INDEX])
2021 || SYMBOLP (attrs[LFACE_INVERSE_INDEX]));
2022 xassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
2023 || IGNORE_DEFFACE_P (attrs[LFACE_FOREGROUND_INDEX])
2024 || STRINGP (attrs[LFACE_FOREGROUND_INDEX]));
2025 xassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
2026 || IGNORE_DEFFACE_P (attrs[LFACE_BACKGROUND_INDEX])
2027 || STRINGP (attrs[LFACE_BACKGROUND_INDEX]));
2028 xassert (UNSPECIFIEDP (attrs[LFACE_INHERIT_INDEX])
2029 || IGNORE_DEFFACE_P (attrs[LFACE_INHERIT_INDEX])
2030 || NILP (attrs[LFACE_INHERIT_INDEX])
2031 || SYMBOLP (attrs[LFACE_INHERIT_INDEX])
2032 || CONSP (attrs[LFACE_INHERIT_INDEX]));
2033 #ifdef HAVE_WINDOW_SYSTEM
2034 xassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
2035 || IGNORE_DEFFACE_P (attrs[LFACE_STIPPLE_INDEX])
2036 || SYMBOLP (attrs[LFACE_STIPPLE_INDEX])
2037 || !NILP (Fbitmap_spec_p (attrs[LFACE_STIPPLE_INDEX])));
2038 xassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX])
2039 || IGNORE_DEFFACE_P (attrs[LFACE_FONT_INDEX])
2040 || FONTP (attrs[LFACE_FONT_INDEX]));
2041 xassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX])
2042 || STRINGP (attrs[LFACE_FONTSET_INDEX]));
2043 #endif
2044 }
2045
2046
2047
2048
2049 static void
2050 check_lface (lface)
2051 Lisp_Object lface;
2052 {
2053 if (!NILP (lface))
2054 {
2055 xassert (LFACEP (lface));
2056 check_lface_attrs (XVECTOR (lface)->contents);
2057 }
2058 }
2059
2060 #else
2061
2062 #define check_lface_attrs(attrs) (void) 0
2063 #define check_lface(lface) (void) 0
2064
2065 #endif
2066
2067
2068
2069
2070
2071 enum named_merge_point_kind
2072 {
2073 NAMED_MERGE_POINT_NORMAL,
2074 NAMED_MERGE_POINT_REMAP
2075 };
2076
2077 2078 2079 2080 2081 2082
2083 struct named_merge_point
2084 {
2085 Lisp_Object face_name;
2086 enum named_merge_point_kind named_merge_point_kind;
2087 struct named_merge_point *prev;
2088 };
2089
2090
2091 2092 2093 2094
2095
2096 static INLINE int
2097 push_named_merge_point (struct named_merge_point *new_named_merge_point,
2098 Lisp_Object face_name,
2099 enum named_merge_point_kind named_merge_point_kind,
2100 struct named_merge_point **named_merge_points)
2101 {
2102 struct named_merge_point *prev;
2103
2104 for (prev = *named_merge_points; prev; prev = prev->prev)
2105 if (EQ (face_name, prev->face_name))
2106 {
2107 if (prev->named_merge_point_kind == named_merge_point_kind)
2108
2109 return 0;
2110 else if (prev->named_merge_point_kind == NAMED_MERGE_POINT_REMAP)
2111 2112 2113 2114
2115 break;
2116 }
2117
2118 new_named_merge_point->face_name = face_name;
2119 new_named_merge_point->named_merge_point_kind = named_merge_point_kind;
2120 new_named_merge_point->prev = *named_merge_points;
2121
2122 *named_merge_points = new_named_merge_point;
2123
2124 return 1;
2125 }
2126
2127
2128
2129 #if 0
2130 static Lisp_Object
2131 internal_resolve_face_name (nargs, args)
2132 int nargs;
2133 Lisp_Object *args;
2134 {
2135 return Fget (args[0], args[1]);
2136 }
2137
2138 static Lisp_Object
2139 resolve_face_name_error (ignore)
2140 Lisp_Object ignore;
2141 {
2142 return Qnil;
2143 }
2144 #endif
2145
2146 2147 2148 2149 2150
2151
2152 static Lisp_Object
2153 resolve_face_name (face_name, signal_p)
2154 Lisp_Object face_name;
2155 int signal_p;
2156 {
2157 Lisp_Object orig_face;
2158 Lisp_Object tortoise, hare;
2159
2160 if (STRINGP (face_name))
2161 face_name = intern (SDATA (face_name));
2162
2163 if (NILP (face_name) || !SYMBOLP (face_name))
2164 return face_name;
2165
2166 orig_face = face_name;
2167 tortoise = hare = face_name;
2168
2169 while (1)
2170 {
2171 face_name = hare;
2172 hare = Fget (hare, Qface_alias);
2173 if (NILP (hare) || !SYMBOLP (hare))
2174 break;
2175
2176 face_name = hare;
2177 hare = Fget (hare, Qface_alias);
2178 if (NILP (hare) || !SYMBOLP (hare))
2179 break;
2180
2181 tortoise = Fget (tortoise, Qface_alias);
2182 if (EQ (hare, tortoise))
2183 {
2184 if (signal_p)
2185 xsignal1 (Qcircular_list, orig_face);
2186 return Qdefault;
2187 }
2188 }
2189
2190 return face_name;
2191 }
2192
2193
2194 2195 2196 2197 2198 2199
2200 static INLINE Lisp_Object
2201 lface_from_face_name_no_resolve (f, face_name, signal_p)
2202 struct frame *f;
2203 Lisp_Object face_name;
2204 int signal_p;
2205 {
2206 Lisp_Object lface;
2207
2208 if (f)
2209 lface = assq_no_quit (face_name, f->face_alist);
2210 else
2211 lface = assq_no_quit (face_name, Vface_new_frame_defaults);
2212
2213 if (CONSP (lface))
2214 lface = XCDR (lface);
2215 else if (signal_p)
2216 signal_error ("Invalid face", face_name);
2217
2218 check_lface (lface);
2219
2220 return lface;
2221 }
2222
2223 2224 2225 2226 2227 2228 2229 2230
2231 static INLINE Lisp_Object
2232 lface_from_face_name (f, face_name, signal_p)
2233 struct frame *f;
2234 Lisp_Object face_name;
2235 int signal_p;
2236 {
2237 face_name = resolve_face_name (face_name, signal_p);
2238 return lface_from_face_name_no_resolve (f, face_name, signal_p);
2239 }
2240
2241
2242 2243 2244 2245 2246
2247
2248 static INLINE int
2249 get_lface_attributes_no_remap (f, face_name, attrs, signal_p)
2250 struct frame *f;
2251 Lisp_Object face_name;
2252 Lisp_Object *attrs;
2253 int signal_p;
2254 {
2255 Lisp_Object lface;
2256
2257 lface = lface_from_face_name_no_resolve (f, face_name, signal_p);
2258
2259 if (! NILP (lface))
2260 bcopy (XVECTOR (lface)->contents, attrs,
2261 LFACE_VECTOR_SIZE * sizeof *attrs);
2262
2263 return !NILP (lface);
2264 }
2265
2266 2267 2268 2269 2270 2271
2272
2273 static INLINE int
2274 get_lface_attributes (f, face_name, attrs, signal_p, named_merge_points)
2275 struct frame *f;
2276 Lisp_Object face_name;
2277 Lisp_Object *attrs;
2278 int signal_p;
2279 struct named_merge_point *named_merge_points;
2280 {
2281 Lisp_Object face_remapping;
2282
2283 face_name = resolve_face_name (face_name, signal_p);
2284
2285 2286
2287 face_remapping = assq_no_quit (face_name, Vface_remapping_alist);
2288 if (CONSP (face_remapping))
2289 {
2290 struct named_merge_point named_merge_point;
2291
2292 if (push_named_merge_point (&named_merge_point,
2293 face_name, NAMED_MERGE_POINT_REMAP,
2294 &named_merge_points))
2295 {
2296 int i;
2297
2298 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
2299 attrs[i] = Qunspecified;
2300
2301 return merge_face_ref (f, XCDR (face_remapping), attrs,
2302 signal_p, named_merge_points);
2303 }
2304 }
2305
2306
2307 return get_lface_attributes_no_remap (f, face_name, attrs, signal_p);
2308 }
2309
2310
2311 2312
2313
2314 static int
2315 lface_fully_specified_p (attrs)
2316 Lisp_Object *attrs;
2317 {
2318 int i;
2319
2320 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
2321 if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX)
2322 if ((UNSPECIFIEDP (attrs[i]) || IGNORE_DEFFACE_P (attrs[i])))
2323 break;
2324
2325 return i == LFACE_VECTOR_SIZE;
2326 }
2327
2328 #ifdef HAVE_WINDOW_SYSTEM
2329
2330 2331 2332 2333
2334
2335 static int
2336 set_lface_from_font (f, lface, font_object, force_p)
2337 struct frame *f;
2338 Lisp_Object lface, font_object;
2339 int force_p;
2340 {
2341 Lisp_Object val;
2342 struct font *font = XFONT_OBJECT (font_object);
2343
2344 2345 2346
2347
2348 if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface)))
2349 {
2350 Lisp_Object family = AREF (font_object, FONT_FAMILY_INDEX);
2351
2352 LFACE_FAMILY (lface) = SYMBOL_NAME (family);
2353 }
2354
2355 if (force_p || UNSPECIFIEDP (LFACE_FOUNDRY (lface)))
2356 {
2357 Lisp_Object foundry = AREF (font_object, FONT_FOUNDRY_INDEX);
2358
2359 LFACE_FOUNDRY (lface) = SYMBOL_NAME (foundry);
2360 }
2361
2362 if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface)))
2363 {
2364 int pt = PIXEL_TO_POINT (font->pixel_size * 10, f->resy);
2365
2366 xassert (pt > 0);
2367 LFACE_HEIGHT (lface) = make_number (pt);
2368 }
2369
2370 if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface)))
2371 {
2372 val = FONT_WEIGHT_FOR_FACE (font_object);
2373 LFACE_WEIGHT (lface) = ! NILP (val) ? val :Qnormal;
2374 }
2375 if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface)))
2376 {
2377 val = FONT_SLANT_FOR_FACE (font_object);
2378 LFACE_SLANT (lface) = ! NILP (val) ? val : Qnormal;
2379 }
2380 if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface)))
2381 {
2382 val = FONT_WIDTH_FOR_FACE (font_object);
2383 LFACE_SWIDTH (lface) = ! NILP (val) ? val : Qnormal;
2384 }
2385
2386 LFACE_FONT (lface) = font_object;
2387 return 1;
2388 }
2389
2390 #endif
2391
2392
2393 2394 2395 2396 2397
2398
2399 Lisp_Object
2400 merge_face_heights (from, to, invalid)
2401 Lisp_Object from, to, invalid;
2402 {
2403 Lisp_Object result = invalid;
2404
2405 if (INTEGERP (from))
2406
2407 result = from;
2408 else if (FLOATP (from))
2409
2410 {
2411 if (INTEGERP (to))
2412
2413 result = make_number ((EMACS_INT)(XFLOAT_DATA (from) * XINT (to)));
2414 else if (FLOATP (to))
2415
2416 result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to));
2417 else if (UNSPECIFIEDP (to))
2418 result = from;
2419 }
2420 else if (FUNCTIONP (from))
2421
2422 {
2423 2424
2425 Lisp_Object args[2];
2426
2427 args[0] = from;
2428 args[1] = to;
2429 result = safe_call (2, args);
2430
2431
2432 if (INTEGERP (to) && !INTEGERP (result))
2433 result = invalid;
2434 }
2435
2436 return result;
2437 }
2438
2439
2440 2441 2442 2443 2444 2445 2446 2447
2448
2449 static INLINE void
2450 merge_face_vectors (f, from, to, named_merge_points)
2451 struct frame *f;
2452 Lisp_Object *from, *to;
2453 struct named_merge_point *named_merge_points;
2454 {
2455 int i;
2456
2457 2458 2459 2460 2461
2462 if (!UNSPECIFIEDP (from[LFACE_INHERIT_INDEX])
2463 && !NILP (from[LFACE_INHERIT_INDEX]))
2464 merge_face_ref (f, from[LFACE_INHERIT_INDEX], to, 0, named_merge_points);
2465
2466 i = LFACE_FONT_INDEX;
2467 if (!UNSPECIFIEDP (from[i]))
2468 {
2469 if (!UNSPECIFIEDP (to[i]))
2470 to[i] = Fmerge_font_spec (from[i], to[i]);
2471 else
2472 to[i] = Fcopy_font_spec (from[i]);
2473 if (! NILP (AREF (to[i], FONT_FOUNDRY_INDEX)))
2474 to[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (to[i], FONT_FOUNDRY_INDEX));
2475 if (! NILP (AREF (to[i], FONT_FAMILY_INDEX)))
2476 to[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (to[i], FONT_FAMILY_INDEX));
2477 if (! NILP (AREF (to[i], FONT_WEIGHT_INDEX)))
2478 to[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (to[i]);
2479 if (! NILP (AREF (to[i], FONT_SLANT_INDEX)))
2480 to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (to[i]);
2481 if (! NILP (AREF (to[i], FONT_WIDTH_INDEX)))
2482 to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (to[i]);
2483 ASET (to[i], FONT_SIZE_INDEX, Qnil);
2484 }
2485
2486 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
2487 if (!UNSPECIFIEDP (from[i]))
2488 {
2489 if (i == LFACE_HEIGHT_INDEX && !INTEGERP (from[i]))
2490 {
2491 to[i] = merge_face_heights (from[i], to[i], to[i]);
2492 font_clear_prop (to, FONT_SIZE_INDEX);
2493 }
2494 else if (i != LFACE_FONT_INDEX
2495 && ! EQ (to[i], from[i]))
2496 {
2497 to[i] = from[i];
2498 if (i >= LFACE_FAMILY_INDEX && i <=LFACE_SLANT_INDEX)
2499 font_clear_prop (to,
2500 (i == LFACE_FAMILY_INDEX ? FONT_FAMILY_INDEX
2501 : i == LFACE_FOUNDRY_INDEX ? FONT_FOUNDRY_INDEX
2502 : i == LFACE_SWIDTH_INDEX ? FONT_WIDTH_INDEX
2503 : i == LFACE_HEIGHT_INDEX ? FONT_SIZE_INDEX
2504 : i == LFACE_WEIGHT_INDEX ? FONT_WEIGHT_INDEX
2505 : FONT_SLANT_INDEX));
2506 }
2507 }
2508
2509 2510
2511 to[LFACE_INHERIT_INDEX] = Qnil;
2512 }
2513
2514 2515 2516 2517
2518
2519 static int
2520 merge_named_face (f, face_name, to, named_merge_points)
2521 struct frame *f;
2522 Lisp_Object face_name;
2523 Lisp_Object *to;
2524 struct named_merge_point *named_merge_points;
2525 {
2526 struct named_merge_point named_merge_point;
2527
2528 if (push_named_merge_point (&named_merge_point,
2529 face_name, NAMED_MERGE_POINT_NORMAL,
2530 &named_merge_points))
2531 {
2532 struct gcpro gcpro1;
2533 Lisp_Object from[LFACE_VECTOR_SIZE];
2534 int ok = get_lface_attributes (f, face_name, from, 0, named_merge_points);
2535
2536 if (ok)
2537 {
2538 GCPRO1 (named_merge_point.face_name);
2539 merge_face_vectors (f, from, to, named_merge_points);
2540 UNGCPRO;
2541 }
2542
2543 return ok;
2544 }
2545 else
2546 return 0;
2547 }
2548
2549
2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571
2572
2573 static int
2574 merge_face_ref (f, face_ref, to, err_msgs, named_merge_points)
2575 struct frame *f;
2576 Lisp_Object face_ref;
2577 Lisp_Object *to;
2578 int err_msgs;
2579 struct named_merge_point *named_merge_points;
2580 {
2581 int ok = 1;
2582
2583 if (CONSP (face_ref))
2584 {
2585 Lisp_Object first = XCAR (face_ref);
2586
2587 if (EQ (first, Qforeground_color)
2588 || EQ (first, Qbackground_color))
2589 {
2590 2591
2592 Lisp_Object color_name = XCDR (face_ref);
2593 Lisp_Object color = first;
2594
2595 if (STRINGP (color_name))
2596 {
2597 if (EQ (color, Qforeground_color))
2598 to[LFACE_FOREGROUND_INDEX] = color_name;
2599 else
2600 to[LFACE_BACKGROUND_INDEX] = color_name;
2601 }
2602 else
2603 {
2604 if (err_msgs)
2605 add_to_log ("Invalid face color", color_name, Qnil);
2606 ok = 0;
2607 }
2608 }
2609 else if (SYMBOLP (first)
2610 && *SDATA (SYMBOL_NAME (first)) == ':')
2611 {
2612
2613 while (CONSP (face_ref) && CONSP (XCDR (face_ref)))
2614 {
2615 Lisp_Object keyword = XCAR (face_ref);
2616 Lisp_Object value = XCAR (XCDR (face_ref));
2617 int err = 0;
2618
2619
2620 if (EQ (value, Qunspecified))
2621 ;
2622 else if (EQ (keyword, QCfamily))
2623 {
2624 if (STRINGP (value))
2625 {
2626 to[LFACE_FAMILY_INDEX] = value;
2627 font_clear_prop (to, FONT_FAMILY_INDEX);
2628 }
2629 else
2630 err = 1;
2631 }
2632 else if (EQ (keyword, QCfoundry))
2633 {
2634 if (STRINGP (value))
2635 {
2636 to[LFACE_FOUNDRY_INDEX] = value;
2637 font_clear_prop (to, FONT_FOUNDRY_INDEX);
2638 }
2639 else
2640 err = 1;
2641 }
2642 else if (EQ (keyword, QCheight))
2643 {
2644 Lisp_Object new_height =
2645 merge_face_heights (value, to[LFACE_HEIGHT_INDEX], Qnil);
2646
2647 if (! NILP (new_height))
2648 {
2649 to[LFACE_HEIGHT_INDEX] = new_height;
2650 font_clear_prop (to, FONT_SIZE_INDEX);
2651 }
2652 else
2653 err = 1;
2654 }
2655 else if (EQ (keyword, QCweight))
2656 {
2657 if (SYMBOLP (value) && FONT_WEIGHT_NAME_NUMERIC (value) >= 0)
2658 {
2659 to[LFACE_WEIGHT_INDEX] = value;
2660 font_clear_prop (to, FONT_WEIGHT_INDEX);
2661 }
2662 else
2663 err = 1;
2664 }
2665 else if (EQ (keyword, QCslant))
2666 {
2667 if (SYMBOLP (value) && FONT_SLANT_NAME_NUMERIC (value) >= 0)
2668 {
2669 to[LFACE_SLANT_INDEX] = value;
2670 font_clear_prop (to, FONT_SLANT_INDEX);
2671 }
2672 else
2673 err = 1;
2674 }
2675 else if (EQ (keyword, QCunderline))
2676 {
2677 if (EQ (value, Qt)
2678 || NILP (value)
2679 || STRINGP (value))
2680 to[LFACE_UNDERLINE_INDEX] = value;
2681 else
2682 err = 1;
2683 }
2684 else if (EQ (keyword, QCoverline))
2685 {
2686 if (EQ (value, Qt)
2687 || NILP (value)
2688 || STRINGP (value))
2689 to[LFACE_OVERLINE_INDEX] = value;
2690 else
2691 err = 1;
2692 }
2693 else if (EQ (keyword, QCstrike_through))
2694 {
2695 if (EQ (value, Qt)
2696 || NILP (value)
2697 || STRINGP (value))
2698 to[LFACE_STRIKE_THROUGH_INDEX] = value;
2699 else
2700 err = 1;
2701 }
2702 else if (EQ (keyword, QCbox))
2703 {
2704 if (EQ (value, Qt))
2705 value = make_number (1);
2706 if (INTEGERP (value)
2707 || STRINGP (value)
2708 || CONSP (value)
2709 || NILP (value))
2710 to[LFACE_BOX_INDEX] = value;
2711 else
2712 err = 1;
2713 }
2714 else if (EQ (keyword, QCinverse_video)
2715 || EQ (keyword, QCreverse_video))
2716 {
2717 if (EQ (value, Qt) || NILP (value))
2718 to[LFACE_INVERSE_INDEX] = value;
2719 else
2720 err = 1;
2721 }
2722 else if (EQ (keyword, QCforeground))
2723 {
2724 if (STRINGP (value))
2725 to[LFACE_FOREGROUND_INDEX] = value;
2726 else
2727 err = 1;
2728 }
2729 else if (EQ (keyword, QCbackground))
2730 {
2731 if (STRINGP (value))
2732 to[LFACE_BACKGROUND_INDEX] = value;
2733 else
2734 err = 1;
2735 }
2736 else if (EQ (keyword, QCstipple))
2737 {
2738 #if defined(HAVE_X_WINDOWS) || defined(HAVE_NS)
2739 Lisp_Object pixmap_p = Fbitmap_spec_p (value);
2740 if (!NILP (pixmap_p))
2741 to[LFACE_STIPPLE_INDEX] = value;
2742 else
2743 err = 1;
2744 #endif
2745 }
2746 else if (EQ (keyword, QCwidth))
2747 {
2748 if (SYMBOLP (value) && FONT_WIDTH_NAME_NUMERIC (value) >= 0)
2749 {
2750 to[LFACE_SWIDTH_INDEX] = value;
2751 font_clear_prop (to, FONT_WIDTH_INDEX);
2752 }
2753 else
2754 err = 1;
2755 }
2756 else if (EQ (keyword, QCinherit))
2757 {
2758 2759
2760 if (! merge_face_ref (f, value, to,
2761 err_msgs, named_merge_points))
2762 err = 1;
2763 }
2764 else
2765 err = 1;
2766
2767 if (err)
2768 {
2769 add_to_log ("Invalid face attribute %S %S", keyword, value);
2770 ok = 0;
2771 }
2772
2773 face_ref = XCDR (XCDR (face_ref));
2774 }
2775 }
2776 else
2777 {
2778 2779 2780
2781 Lisp_Object next = XCDR (face_ref);
2782
2783 if (! NILP (next))
2784 ok = merge_face_ref (f, next, to, err_msgs, named_merge_points);
2785
2786 if (! merge_face_ref (f, first, to, err_msgs, named_merge_points))
2787 ok = 0;
2788 }
2789 }
2790 else
2791 {
2792
2793 ok = merge_named_face (f, face_ref, to, named_merge_points);
2794 if (!ok && err_msgs)
2795 add_to_log ("Invalid face reference: %s", face_ref, Qnil);
2796 }
2797
2798 return ok;
2799 }
2800
2801
2802 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face,
2803 Sinternal_make_lisp_face, 1, 2, 0,
2804 doc: 2805 2806 2807 2808 )
2809 (face, frame)
2810 Lisp_Object face, frame;
2811 {
2812 Lisp_Object global_lface, lface;
2813 struct frame *f;
2814 int i;
2815
2816 CHECK_SYMBOL (face);
2817 global_lface = lface_from_face_name (NULL, face, 0);
2818
2819 if (!NILP (frame))
2820 {
2821 CHECK_LIVE_FRAME (frame);
2822 f = XFRAME (frame);
2823 lface = lface_from_face_name (f, face, 0);
2824 }
2825 else
2826 f = NULL, lface = Qnil;
2827
2828
2829 if (NILP (global_lface))
2830 {
2831 global_lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
2832 Qunspecified);
2833 ASET (global_lface, 0, Qface);
2834 Vface_new_frame_defaults = Fcons (Fcons (face, global_lface),
2835 Vface_new_frame_defaults);
2836
2837 2838 2839 2840
2841 if (next_lface_id == lface_id_to_name_size)
2842 {
2843 int new_size = max (50, 2 * lface_id_to_name_size);
2844 int sz = new_size * sizeof *lface_id_to_name;
2845 lface_id_to_name = (Lisp_Object *) xrealloc (lface_id_to_name, sz);
2846 lface_id_to_name_size = new_size;
2847 }
2848
2849 lface_id_to_name[next_lface_id] = face;
2850 Fput (face, Qface, make_number (next_lface_id));
2851 ++next_lface_id;
2852 }
2853 else if (f == NULL)
2854 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
2855 ASET (global_lface, i, Qunspecified);
2856
2857
2858 if (f)
2859 {
2860 if (NILP (lface))
2861 {
2862 lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
2863 Qunspecified);
2864 ASET (lface, 0, Qface);
2865 f->face_alist = Fcons (Fcons (face, lface), f->face_alist);
2866 }
2867 else
2868 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
2869 ASET (lface, i, Qunspecified);
2870 }
2871 else
2872 lface = global_lface;
2873
2874 2875 2876 2877 2878
2879 if (NILP (Fget (face, Qface_no_inherit)))
2880 {
2881 ++face_change_count;
2882 ++windows_or_buffers_changed;
2883 }
2884
2885 xassert (LFACEP (lface));
2886 check_lface (lface);
2887 return lface;
2888 }
2889
2890
2891 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p,
2892 Sinternal_lisp_face_p, 1, 2, 0,
2893 doc: 2894 2895 2896 2897 )
2898 (face, frame)
2899 Lisp_Object face, frame;
2900 {
2901 Lisp_Object lface;
2902
2903 face = resolve_face_name (face, 1);
2904
2905 if (!NILP (frame))
2906 {
2907 CHECK_LIVE_FRAME (frame);
2908 lface = lface_from_face_name (XFRAME (frame), face, 0);
2909 }
2910 else
2911 lface = lface_from_face_name (NULL, face, 0);
2912
2913 return lface;
2914 }
2915
2916
2917 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face,
2918 Sinternal_copy_lisp_face, 4, 4, 0,
2919 doc: 2920 2921 2922 2923 2924 2925 2926 )
2927 (from, to, frame, new_frame)
2928 Lisp_Object from, to, frame, new_frame;
2929 {
2930 Lisp_Object lface, copy;
2931
2932 CHECK_SYMBOL (from);
2933 CHECK_SYMBOL (to);
2934
2935 if (EQ (frame, Qt))
2936 {
2937 2938
2939 lface = lface_from_face_name (NULL, from, 1);
2940 copy = Finternal_make_lisp_face (to, Qnil);
2941 }
2942 else
2943 {
2944
2945 if (NILP (new_frame))
2946 new_frame = frame;
2947 CHECK_LIVE_FRAME (frame);
2948 CHECK_LIVE_FRAME (new_frame);
2949 lface = lface_from_face_name (XFRAME (frame), from, 1);
2950 copy = Finternal_make_lisp_face (to, new_frame);
2951 }
2952
2953 bcopy (XVECTOR (lface)->contents, XVECTOR (copy)->contents,
2954 LFACE_VECTOR_SIZE * sizeof (Lisp_Object));
2955
2956 2957 2958 2959 2960
2961 if (NILP (Fget (to, Qface_no_inherit)))
2962 {
2963 ++face_change_count;
2964 ++windows_or_buffers_changed;
2965 }
2966
2967 return to;
2968 }
2969
2970
2971 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute,
2972 Sinternal_set_lisp_face_attribute, 3, 4, 0,
2973 doc: 2974 2975 2976 2977 2978 )
2979 (face, attr, value, frame)
2980 Lisp_Object face, attr, value, frame;
2981 {
2982 Lisp_Object lface;
2983 Lisp_Object old_value = Qnil;
2984 2985
2986 enum font_property_index prop_index = 0;
2987
2988 CHECK_SYMBOL (face);
2989 CHECK_SYMBOL (attr);
2990
2991 face = resolve_face_name (face, 1);
2992
2993 2994
2995 if (INTEGERP (frame) && XINT (frame) == 0)
2996 {
2997 Lisp_Object tail;
2998 Finternal_set_lisp_face_attribute (face, attr, value, Qt);
2999 FOR_EACH_FRAME (tail, frame)
3000 Finternal_set_lisp_face_attribute (face, attr, value, frame);
3001 return face;
3002 }
3003
3004
3005 if (EQ (frame, Qt))
3006 {
3007 lface = lface_from_face_name (NULL, face, 1);
3008
3009 3010 3011 3012 3013 3014
3015 if (UNSPECIFIEDP (value))
3016 value = Qignore_defface;
3017 }
3018 else
3019 {
3020 if (NILP (frame))
3021 frame = selected_frame;
3022
3023 CHECK_LIVE_FRAME (frame);
3024 lface = lface_from_face_name (XFRAME (frame), face, 0);
3025
3026
3027 if (NILP (lface))
3028 lface = Finternal_make_lisp_face (face, frame);
3029 }
3030
3031 if (EQ (attr, QCfamily))
3032 {
3033 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3034 {
3035 CHECK_STRING (value);
3036 if (SCHARS (value) == 0)
3037 signal_error ("Invalid face family", value);
3038 }
3039 old_value = LFACE_FAMILY (lface);
3040 LFACE_FAMILY (lface) = value;
3041 prop_index = FONT_FAMILY_INDEX;
3042 }
3043 else if (EQ (attr, QCfoundry))
3044 {
3045 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3046 {
3047 CHECK_STRING (value);
3048 if (SCHARS (value) == 0)
3049 signal_error ("Invalid face foundry", value);
3050 }
3051 old_value = LFACE_FOUNDRY (lface);
3052 LFACE_FOUNDRY (lface) = value;
3053 prop_index = FONT_FOUNDRY_INDEX;
3054 }
3055 else if (EQ (attr, QCheight))
3056 {
3057 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3058 {
3059 if (EQ (face, Qdefault))
3060 {
3061
3062 if (!INTEGERP (value) || XINT (value) <= 0)
3063 signal_error ("Invalid default face height", value);
3064 }
3065 else
3066 {
3067 3068
3069 Lisp_Object test = merge_face_heights (value,
3070 make_number (10),
3071 Qnil);
3072 if (!INTEGERP (test) || XINT (test) <= 0)
3073 signal_error ("Invalid face height", value);
3074 }
3075 }
3076
3077 old_value = LFACE_HEIGHT (lface);
3078 LFACE_HEIGHT (lface) = value;
3079 prop_index = FONT_SIZE_INDEX;
3080 }
3081 else if (EQ (attr, QCweight))
3082 {
3083 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3084 {
3085 CHECK_SYMBOL (value);
3086 if (FONT_WEIGHT_NAME_NUMERIC (value) < 0)
3087 signal_error ("Invalid face weight", value);
3088 }
3089 old_value = LFACE_WEIGHT (lface);
3090 LFACE_WEIGHT (lface) = value;
3091 prop_index = FONT_WEIGHT_INDEX;
3092 }
3093 else if (EQ (attr, QCslant))
3094 {
3095 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3096 {
3097 CHECK_SYMBOL (value);
3098 if (FONT_SLANT_NAME_NUMERIC (value) < 0)
3099 signal_error ("Invalid face slant", value);
3100 }
3101 old_value = LFACE_SLANT (lface);
3102 LFACE_SLANT (lface) = value;
3103 prop_index = FONT_SLANT_INDEX;
3104 }
3105 else if (EQ (attr, QCunderline))
3106 {
3107 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3108 if ((SYMBOLP (value)
3109 && !EQ (value, Qt)
3110 && !EQ (value, Qnil))
3111
3112 || (STRINGP (value)
3113 && SCHARS (value) == 0))
3114 signal_error ("Invalid face underline", value);
3115
3116 old_value = LFACE_UNDERLINE (lface);
3117 LFACE_UNDERLINE (lface) = value;
3118 }
3119 else if (EQ (attr, QCoverline))
3120 {
3121 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3122 if ((SYMBOLP (value)
3123 && !EQ (value, Qt)
3124 && !EQ (value, Qnil))
3125
3126 || (STRINGP (value)
3127 && SCHARS (value) == 0))
3128 signal_error ("Invalid face overline", value);
3129
3130 old_value = LFACE_OVERLINE (lface);
3131 LFACE_OVERLINE (lface) = value;
3132 }
3133 else if (EQ (attr, QCstrike_through))
3134 {
3135 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3136 if ((SYMBOLP (value)
3137 && !EQ (value, Qt)
3138 && !EQ (value, Qnil))
3139
3140 || (STRINGP (value)
3141 && SCHARS (value) == 0))
3142 signal_error ("Invalid face strike-through", value);
3143
3144 old_value = LFACE_STRIKE_THROUGH (lface);
3145 LFACE_STRIKE_THROUGH (lface) = value;
3146 }
3147 else if (EQ (attr, QCbox))
3148 {
3149 int valid_p;
3150
3151 3152
3153 if (EQ (value, Qt))
3154 value = make_number (1);
3155
3156 if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value))
3157 valid_p = 1;
3158 else if (NILP (value))
3159 valid_p = 1;
3160 else if (INTEGERP (value))
3161 valid_p = XINT (value) != 0;
3162 else if (STRINGP (value))
3163 valid_p = SCHARS (value) > 0;
3164 else if (CONSP (value))
3165 {
3166 Lisp_Object tem;
3167
3168 tem = value;
3169 while (CONSP (tem))
3170 {
3171 Lisp_Object k, v;
3172
3173 k = XCAR (tem);
3174 tem = XCDR (tem);
3175 if (!CONSP (tem))
3176 break;
3177 v = XCAR (tem);
3178 tem = XCDR (tem);
3179
3180 if (EQ (k, QCline_width))
3181 {
3182 if (!INTEGERP (v) || XINT (v) == 0)
3183 break;
3184 }
3185 else if (EQ (k, QCcolor))
3186 {
3187 if (!NILP (v) && (!STRINGP (v) || SCHARS (v) == 0))
3188 break;
3189 }
3190 else if (EQ (k, QCstyle))
3191 {
3192 if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button))
3193 break;
3194 }
3195 else
3196 break;
3197 }
3198
3199 valid_p = NILP (tem);
3200 }
3201 else
3202 valid_p = 0;
3203
3204 if (!valid_p)
3205 signal_error ("Invalid face box", value);
3206
3207 old_value = LFACE_BOX (lface);
3208 LFACE_BOX (lface) = value;
3209 }
3210 else if (EQ (attr, QCinverse_video)
3211 || EQ (attr, QCreverse_video))
3212 {
3213 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3214 {
3215 CHECK_SYMBOL (value);
3216 if (!EQ (value, Qt) && !NILP (value))
3217 signal_error ("Invalid inverse-video face attribute value", value);
3218 }
3219 old_value = LFACE_INVERSE (lface);
3220 LFACE_INVERSE (lface) = value;
3221 }
3222 else if (EQ (attr, QCforeground))
3223 {
3224
3225 if (NILP (value))
3226 value = Qunspecified;
3227 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3228 {
3229 3230 3231
3232 CHECK_STRING (value);
3233 if (SCHARS (value) == 0)
3234 signal_error ("Empty foreground color value", value);
3235 }
3236 old_value = LFACE_FOREGROUND (lface);
3237 LFACE_FOREGROUND (lface) = value;
3238 }
3239 else if (EQ (attr, QCbackground))
3240 {
3241
3242 if (NILP (value))
3243 value = Qunspecified;
3244 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3245 {
3246 3247 3248
3249 CHECK_STRING (value);
3250 if (SCHARS (value) == 0)
3251 signal_error ("Empty background color value", value);
3252 }
3253 old_value = LFACE_BACKGROUND (lface);
3254 LFACE_BACKGROUND (lface) = value;
3255 }
3256 else if (EQ (attr, QCstipple))
3257 {
3258 #if defined(HAVE_X_WINDOWS) || defined(HAVE_NS)
3259 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)
3260 && !NILP (value)
3261 && NILP (Fbitmap_spec_p (value)))
3262 signal_error ("Invalid stipple attribute", value);
3263 old_value = LFACE_STIPPLE (lface);
3264 LFACE_STIPPLE (lface) = value;
3265 #endif
3266 }
3267 else if (EQ (attr, QCwidth))
3268 {
3269 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3270 {
3271 CHECK_SYMBOL (value);
3272 if (FONT_WIDTH_NAME_NUMERIC (value) < 0)
3273 signal_error ("Invalid face width", value);
3274 }
3275 old_value = LFACE_SWIDTH (lface);
3276 LFACE_SWIDTH (lface) = value;
3277 prop_index = FONT_WIDTH_INDEX;
3278 }
3279 else if (EQ (attr, QCfont))
3280 {
3281 #ifdef HAVE_WINDOW_SYSTEM
3282 if (EQ (frame, Qt) || FRAME_WINDOW_P (XFRAME (frame)))
3283 {
3284 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
3285 {
3286 FRAME_PTR f;
3287
3288 old_value = LFACE_FONT (lface);
3289 if (! FONTP (value))
3290 {
3291 if (STRINGP (value))
3292 {
3293 Lisp_Object name = value;
3294 int fontset = fs_query_fontset (name, 0);
3295
3296 if (fontset >= 0)
3297 name = fontset_ascii (fontset);
3298 value = font_spec_from_name (name);
3299 if (!FONTP (value))
3300 signal_error ("Invalid font name", name);
3301 }
3302 else
3303 signal_error ("Invalid font or font-spec", value);
3304 }
3305 if (EQ (frame, Qt))
3306 f = XFRAME (selected_frame);
3307 else
3308 f = XFRAME (frame);
3309 if (! FONT_OBJECT_P (value))
3310 {
3311 Lisp_Object *attrs = XVECTOR (lface)->contents;
3312 Lisp_Object font_object;
3313
3314 font_object = font_load_for_lface (f, attrs, value);
3315 if (NILP (font_object))
3316 signal_error ("Font not available", value);
3317 value = font_object;
3318 }
3319 set_lface_from_font (f, lface, value, 1);
3320 }
3321 else
3322 LFACE_FONT (lface) = value;
3323 }
3324 #endif
3325 }
3326 else if (EQ (attr, QCfontset))
3327 {
3328 #ifdef HAVE_WINDOW_SYSTEM
3329 if (EQ (frame, Qt) || FRAME_WINDOW_P (XFRAME (frame)))
3330 {
3331 Lisp_Object tmp;
3332
3333 old_value = LFACE_FONTSET (lface);
3334 tmp = Fquery_fontset (value, Qnil);
3335 if (NILP (tmp))
3336 signal_error ("Invalid fontset name", value);
3337 LFACE_FONTSET (lface) = value = tmp;
3338 }
3339 #endif
3340 }
3341 else if (EQ (attr, QCinherit))
3342 {
3343 Lisp_Object tail;
3344 if (SYMBOLP (value))
3345 tail = Qnil;
3346 else
3347 for (tail = value; CONSP (tail); tail = XCDR (tail))
3348 if (!SYMBOLP (XCAR (tail)))
3349 break;
3350 if (NILP (tail))
3351 LFACE_INHERIT (lface) = value;
3352 else
3353 signal_error ("Invalid face inheritance", value);
3354 }
3355 else if (EQ (attr, QCbold))
3356 {
3357 old_value = LFACE_WEIGHT (lface);
3358 LFACE_WEIGHT (lface) = NILP (value) ? Qnormal : Qbold;
3359 prop_index = FONT_WEIGHT_INDEX;
3360 }
3361 else if (EQ (attr, QCitalic))
3362 {
3363 attr = QCslant;
3364 old_value = LFACE_SLANT (lface);
3365 LFACE_SLANT (lface) = NILP (value) ? Qnormal : Qitalic;
3366 prop_index = FONT_SLANT_INDEX;
3367 }
3368 else
3369 signal_error ("Invalid face attribute name", attr);
3370
3371 if (prop_index)
3372 {
3373 3374 3375 3376 3377 3378
3379 font_clear_prop (XVECTOR (lface)->contents, prop_index);
3380 }
3381
3382 3383 3384 3385 3386
3387 if (!EQ (frame, Qt)
3388 && NILP (Fget (face, Qface_no_inherit))
3389 && NILP (Fequal (old_value, value)))
3390 {
3391 ++face_change_count;
3392 ++windows_or_buffers_changed;
3393 }
3394
3395 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)
3396 && NILP (Fequal (old_value, value)))
3397 {
3398 Lisp_Object param;
3399
3400 param = Qnil;
3401
3402 if (EQ (face, Qdefault))
3403 {
3404 #ifdef HAVE_WINDOW_SYSTEM
3405 3406
3407 if (FRAMEP (frame)
3408 && (prop_index || EQ (attr, QCfont))
3409 && lface_fully_specified_p (XVECTOR (lface)->contents))
3410 set_font_frame_param (frame, lface);
3411 else
3412 #endif
3413
3414 if (EQ (attr, QCforeground))
3415 param = Qforeground_color;
3416 else if (EQ (attr, QCbackground))
3417 param = Qbackground_color;
3418 }
3419 #ifdef HAVE_WINDOW_SYSTEM
3420 #ifndef WINDOWSNT
3421 else if (EQ (face, Qscroll_bar))
3422 {
3423 3424
3425 if (EQ (attr, QCforeground))
3426 param = Qscroll_bar_foreground;
3427 else if (EQ (attr, QCbackground))
3428 param = Qscroll_bar_background;
3429 }
3430 #endif
3431 else if (EQ (face, Qborder))
3432 {
3433 3434
3435 if (EQ (attr, QCbackground))
3436 param = Qborder_color;
3437 }
3438 else if (EQ (face, Qcursor))
3439 {
3440 3441
3442 if (EQ (attr, QCbackground))
3443 param = Qcursor_color;
3444 }
3445 else if (EQ (face, Qmouse))
3446 {
3447 3448
3449 if (EQ (attr, QCbackground))
3450 param = Qmouse_color;
3451 }
3452 #endif
3453 else if (EQ (face, Qmenu))
3454 {
3455 3456 3457 3458
3459 if (FRAMEP (frame))
3460 {
3461 struct frame *f = XFRAME (frame);
3462 if (FRAME_FACE_CACHE (f) == NULL)
3463 FRAME_FACE_CACHE (f) = make_face_cache (f);
3464 FRAME_FACE_CACHE (f)->menu_face_changed_p = 1;
3465 }
3466 else
3467 menu_face_changed_default = 1;
3468 }
3469
3470 if (!NILP (param))
3471 {
3472 if (EQ (frame, Qt))
3473
3474 {
3475 store_in_alist (&Vdefault_frame_alist, param, value);
3476 }
3477 else
3478
3479 {
3480 Lisp_Object cons;
3481 cons = XCAR (Vparam_value_alist);
3482 XSETCAR (cons, param);
3483 XSETCDR (cons, value);
3484 Fmodify_frame_parameters (frame, Vparam_value_alist);
3485 }
3486 }
3487 }
3488
3489 return face;
3490 }
3491
3492
3493 #ifdef HAVE_WINDOW_SYSTEM
3494
3495 3496
3497
3498 static void
3499 set_font_frame_param (frame, lface)
3500 Lisp_Object frame, lface;
3501 {
3502 struct frame *f = XFRAME (frame);
3503 Lisp_Object font;
3504
3505 if (FRAME_WINDOW_P (f)
3506 3507
3508 && (font = LFACE_FONT (lface),
3509 ! UNSPECIFIEDP (font)))
3510 {
3511 if (FONT_SPEC_P (font))
3512 {
3513 font = font_load_for_lface (f, XVECTOR (lface)->contents, font);
3514 if (NILP (font))
3515 return;
3516 LFACE_FONT (lface) = font;
3517 }
3518 f->default_face_done_p = 0;
3519 Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font), Qnil));
3520 }
3521 }
3522
3523
3524 3525
3526
3527 void
3528 update_face_from_frame_parameter (f, param, new_value)
3529 struct frame *f;
3530 Lisp_Object param, new_value;
3531 {
3532 Lisp_Object face = Qnil;
3533 Lisp_Object lface;
3534
3535 3536 3537
3538 if (NILP (f->face_alist))
3539 return;
3540
3541 if (EQ (param, Qforeground_color))
3542 {
3543 face = Qdefault;
3544 lface = lface_from_face_name (f, face, 1);
3545 LFACE_FOREGROUND (lface) = (STRINGP (new_value)
3546 ? new_value : Qunspecified);
3547 realize_basic_faces (f);
3548 }
3549 else if (EQ (param, Qbackground_color))
3550 {
3551 Lisp_Object frame;
3552
3553 3554 3555
3556 XSETFRAME (frame, f);
3557 call1 (Qframe_set_background_mode, frame);
3558
3559 face = Qdefault;
3560 lface = lface_from_face_name (f, face, 1);
3561 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
3562 ? new_value : Qunspecified);
3563 realize_basic_faces (f);
3564 }
3565 else if (EQ (param, Qborder_color))
3566 {
3567 face = Qborder;
3568 lface = lface_from_face_name (f, face, 1);
3569 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
3570 ? new_value : Qunspecified);
3571 }
3572 else if (EQ (param, Qcursor_color))
3573 {
3574 face = Qcursor;
3575 lface = lface_from_face_name (f, face, 1);
3576 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
3577 ? new_value : Qunspecified);
3578 }
3579 else if (EQ (param, Qmouse_color))
3580 {
3581 face = Qmouse;
3582 lface = lface_from_face_name (f, face, 1);
3583 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
3584 ? new_value : Qunspecified);
3585 }
3586
3587 3588 3589 3590 3591
3592 if (!NILP (face)
3593 && NILP (Fget (face, Qface_no_inherit)))
3594 {
3595 ++face_change_count;
3596 ++windows_or_buffers_changed;
3597 }
3598 }
3599
3600
3601 3602 3603
3604
3605 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource,
3606 Sinternal_face_x_get_resource, 3, 3, 0, doc: )
3607 (resource, class, frame)
3608 Lisp_Object resource, class, frame;
3609 {
3610 Lisp_Object value = Qnil;
3611 CHECK_STRING (resource);
3612 CHECK_STRING (class);
3613 CHECK_LIVE_FRAME (frame);
3614 BLOCK_INPUT;
3615 value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)),
3616 resource, class, Qnil, Qnil);
3617 UNBLOCK_INPUT;
3618 return value;
3619 }
3620
3621
3622 3623 3624 3625
3626
3627 static Lisp_Object
3628 face_boolean_x_resource_value (value, signal_p)
3629 Lisp_Object value;
3630 int signal_p;
3631 {
3632 Lisp_Object result = make_number (0);
3633
3634 xassert (STRINGP (value));
3635
3636 if (xstrcasecmp (SDATA (value), "on") == 0
3637 || xstrcasecmp (SDATA (value), "true") == 0)
3638 result = Qt;
3639 else if (xstrcasecmp (SDATA (value), "off") == 0
3640 || xstrcasecmp (SDATA (value), "false") == 0)
3641 result = Qnil;
3642 else if (xstrcasecmp (SDATA (value), "unspecified") == 0)
3643 result = Qunspecified;
3644 else if (signal_p)
3645 signal_error ("Invalid face attribute value from X resource", value);
3646
3647 return result;
3648 }
3649
3650
3651 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3652 Finternal_set_lisp_face_attribute_from_resource,
3653 Sinternal_set_lisp_face_attribute_from_resource,
3654 3, 4, 0, doc: )
3655 (face, attr, value, frame)
3656 Lisp_Object face, attr, value, frame;
3657 {
3658 CHECK_SYMBOL (face);
3659 CHECK_SYMBOL (attr);
3660 CHECK_STRING (value);
3661
3662 if (xstrcasecmp (SDATA (value), "unspecified") == 0)
3663 value = Qunspecified;
3664 else if (EQ (attr, QCheight))
3665 {
3666 value = Fstring_to_number (value, make_number (10));
3667 if (XINT (value) <= 0)
3668 signal_error ("Invalid face height from X resource", value);
3669 }
3670 else if (EQ (attr, QCbold) || EQ (attr, QCitalic))
3671 value = face_boolean_x_resource_value (value, 1);
3672 else if (EQ (attr, QCweight) || EQ (attr, QCslant) || EQ (attr, QCwidth))
3673 value = intern (SDATA (value));
3674 else if (EQ (attr, QCreverse_video) || EQ (attr, QCinverse_video))
3675 value = face_boolean_x_resource_value (value, 1);
3676 else if (EQ (attr, QCunderline)
3677 || EQ (attr, QCoverline)
3678 || EQ (attr, QCstrike_through))
3679 {
3680 Lisp_Object boolean_value;
3681
3682 3683
3684 boolean_value = face_boolean_x_resource_value (value, 0);
3685 if (SYMBOLP (boolean_value))
3686 value = boolean_value;
3687 }
3688 else if (EQ (attr, QCbox) || EQ (attr, QCinherit))
3689 value = Fcar (Fread_from_string (value, Qnil, Qnil));
3690
3691 return Finternal_set_lisp_face_attribute (face, attr, value, frame);
3692 }
3693
3694 #endif
3695
3696
3697 3698 3699
3700
3701 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3702
3703
3704
3705 static void
3706 x_update_menu_appearance (f)
3707 struct frame *f;
3708 {
3709 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3710 XrmDatabase rdb;
3711
3712 if (dpyinfo
3713 && (rdb = XrmGetDatabase (FRAME_X_DISPLAY (f)),
3714 rdb != NULL))
3715 {
3716 char line[512];
3717 Lisp_Object lface = lface_from_face_name (f, Qmenu, 1);
3718 struct face *face = FACE_FROM_ID (f, MENU_FACE_ID);
3719 const char *myname = SDATA (Vx_resource_name);
3720 int changed_p = 0;
3721 #ifdef USE_MOTIF
3722 const char *popup_path = "popup_menu";
3723 #else
3724 const char *popup_path = "menu.popup";
3725 #endif
3726
3727 if (STRINGP (LFACE_FOREGROUND (lface)))
3728 {
3729 sprintf (line, "%s.%s*foreground: %s",
3730 myname, popup_path,
3731 SDATA (LFACE_FOREGROUND (lface)));
3732 XrmPutLineResource (&rdb, line);
3733 sprintf (line, "%s.pane.menubar*foreground: %s",
3734 myname, SDATA (LFACE_FOREGROUND (lface)));
3735 XrmPutLineResource (&rdb, line);
3736 changed_p = 1;
3737 }
3738
3739 if (STRINGP (LFACE_BACKGROUND (lface)))
3740 {
3741 sprintf (line, "%s.%s*background: %s",
3742 myname, popup_path,
3743 SDATA (LFACE_BACKGROUND (lface)));
3744 XrmPutLineResource (&rdb, line);
3745 sprintf (line, "%s.pane.menubar*background: %s",
3746 myname, SDATA (LFACE_BACKGROUND (lface)));
3747 XrmPutLineResource (&rdb, line);
3748 changed_p = 1;
3749 }
3750
3751 if (face->font
3752 3753 3754
3755 && FONTP (LFACE_FONT (lface))
3756 && (!UNSPECIFIEDP (LFACE_FAMILY (lface))
3757 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface))
3758 || !UNSPECIFIEDP (LFACE_SWIDTH (lface))
3759 || !UNSPECIFIEDP (LFACE_WEIGHT (lface))
3760 || !UNSPECIFIEDP (LFACE_SLANT (lface))
3761 || !UNSPECIFIEDP (LFACE_HEIGHT (lface))))
3762 {
3763 Lisp_Object xlfd = Ffont_xlfd_name (LFACE_FONT (lface), Qnil);
3764 #ifdef USE_MOTIF
3765 const char *suffix = "List";
3766 Bool motif = True;
3767 #else
3768 #if defined HAVE_X_I18N
3769
3770 const char *suffix = "Set";
3771 #else
3772 const char *suffix = "";
3773 #endif
3774 Bool motif = False;
3775 #endif
3776
3777 if (! NILP (xlfd))
3778 {
3779 #if defined HAVE_X_I18N
3780 extern char *xic_create_fontsetname
3781 P_ ((char *base_fontname, Bool motif));
3782 char *fontsetname = xic_create_fontsetname (SDATA (xlfd), motif);
3783 #else
3784 char *fontsetname = (char *) SDATA (xlfd);
3785 #endif
3786 sprintf (line, "%s.pane.menubar*font%s: %s",
3787 myname, suffix, fontsetname);
3788 XrmPutLineResource (&rdb, line);
3789 sprintf (line, "%s.%s*font%s: %s",
3790 myname, popup_path, suffix, fontsetname);
3791 XrmPutLineResource (&rdb, line);
3792 changed_p = 1;
3793 if (fontsetname != (char *) SDATA (xlfd))
3794 xfree (fontsetname);
3795 }
3796 }
3797
3798 if (changed_p && f->output_data.x->menubar_widget)
3799 free_frame_menubar (f);
3800 }
3801 }
3802
3803 #endif
3804
3805
3806 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p,
3807 Sface_attribute_relative_p,
3808 2, 2, 0,
3809 doc: 3810 3811 3812 3813 3814 3815 3816 )
3817 (attribute, value)
3818 Lisp_Object attribute, value;
3819 {
3820 if (EQ (value, Qunspecified) || (EQ (value, Qignore_defface)))
3821 return Qt;
3822 else if (EQ (attribute, QCheight))
3823 return INTEGERP (value) ? Qnil : Qt;
3824 else
3825 return Qnil;
3826 }
3827
3828 DEFUN ("merge-face-attribute", Fmerge_face_attribute, Smerge_face_attribute,
3829 3, 3, 0,
3830 doc: 3831 3832 )
3833 (attribute, value1, value2)
3834 Lisp_Object attribute, value1, value2;
3835 {
3836 if (EQ (value1, Qunspecified) || EQ (value1, Qignore_defface))
3837 return value2;
3838 else if (EQ (attribute, QCheight))
3839 return merge_face_heights (value1, value2, value1);
3840 else
3841 return value1;
3842 }
3843
3844
3845 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute,
3846 Sinternal_get_lisp_face_attribute,
3847 2, 3, 0,
3848 doc: 3849 3850 3851 3852 3853 )
3854 (symbol, keyword, frame)
3855 Lisp_Object symbol, keyword, frame;
3856 {
3857 Lisp_Object lface, value = Qnil;
3858
3859 CHECK_SYMBOL (symbol);
3860 CHECK_SYMBOL (keyword);
3861
3862 if (EQ (frame, Qt))
3863 lface = lface_from_face_name (NULL, symbol, 1);
3864 else
3865 {
3866 if (NILP (frame))
3867 frame = selected_frame;
3868 CHECK_LIVE_FRAME (frame);
3869 lface = lface_from_face_name (XFRAME (frame), symbol, 1);
3870 }
3871
3872 if (EQ (keyword, QCfamily))
3873 value = LFACE_FAMILY (lface);
3874 else if (EQ (keyword, QCfoundry))
3875 value = LFACE_FOUNDRY (lface);
3876 else if (EQ (keyword, QCheight))
3877 value = LFACE_HEIGHT (lface);
3878 else if (EQ (keyword, QCweight))
3879 value = LFACE_WEIGHT (lface);
3880 else if (EQ (keyword, QCslant))
3881 value = LFACE_SLANT (lface);
3882 else if (EQ (keyword, QCunderline))
3883 value = LFACE_UNDERLINE (lface);
3884 else if (EQ (keyword, QCoverline))
3885 value = LFACE_OVERLINE (lface);
3886 else if (EQ (keyword, QCstrike_through))
3887 value = LFACE_STRIKE_THROUGH (lface);
3888 else if (EQ (keyword, QCbox))
3889 value = LFACE_BOX (lface);
3890 else if (EQ (keyword, QCinverse_video)
3891 || EQ (keyword, QCreverse_video))
3892 value = LFACE_INVERSE (lface);
3893 else if (EQ (keyword, QCforeground))
3894 value = LFACE_FOREGROUND (lface);
3895 else if (EQ (keyword, QCbackground))
3896 value = LFACE_BACKGROUND (lface);
3897 else if (EQ (keyword, QCstipple))
3898 value = LFACE_STIPPLE (lface);
3899 else if (EQ (keyword, QCwidth))
3900 value = LFACE_SWIDTH (lface);
3901 else if (EQ (keyword, QCinherit))
3902 value = LFACE_INHERIT (lface);
3903 else if (EQ (keyword, QCfont))
3904 value = LFACE_FONT (lface);
3905 else if (EQ (keyword, QCfontset))
3906 value = LFACE_FONTSET (lface);
3907 else
3908 signal_error ("Invalid face attribute name", keyword);
3909
3910 if (IGNORE_DEFFACE_P (value))
3911 return Qunspecified;
3912
3913 return value;
3914 }
3915
3916
3917 DEFUN ("internal-lisp-face-attribute-values",
3918 Finternal_lisp_face_attribute_values,
3919 Sinternal_lisp_face_attribute_values, 1, 1, 0,
3920 doc: 3921 )
3922 (attr)
3923 Lisp_Object attr;
3924 {
3925 Lisp_Object result = Qnil;
3926
3927 CHECK_SYMBOL (attr);
3928
3929 if (EQ (attr, QCunderline))
3930 result = Fcons (Qt, Fcons (Qnil, Qnil));
3931 else if (EQ (attr, QCoverline))
3932 result = Fcons (Qt, Fcons (Qnil, Qnil));
3933 else if (EQ (attr, QCstrike_through))
3934 result = Fcons (Qt, Fcons (Qnil, Qnil));
3935 else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video))
3936 result = Fcons (Qt, Fcons (Qnil, Qnil));
3937
3938 return result;
3939 }
3940
3941
3942 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face,
3943 Sinternal_merge_in_global_face, 2, 2, 0,
3944 doc: 3945 )
3946 (face, frame)
3947 Lisp_Object face, frame;
3948 {
3949 int i;
3950 Lisp_Object global_lface, local_lface, *gvec, *lvec;
3951 struct frame *f = XFRAME (frame);
3952
3953 CHECK_LIVE_FRAME (frame);
3954 global_lface = lface_from_face_name (NULL, face, 1);
3955 local_lface = lface_from_face_name (f, face, 0);
3956 if (NILP (local_lface))
3957 local_lface = Finternal_make_lisp_face (face, frame);
3958
3959 3960 3961 3962 3963
3964 lvec = XVECTOR (local_lface)->contents;
3965 gvec = XVECTOR (global_lface)->contents;
3966 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
3967 if (IGNORE_DEFFACE_P (gvec[i]))
3968 lvec[i] = Qunspecified;
3969 else if (! UNSPECIFIEDP (gvec[i]))
3970 lvec[i] = gvec[i];
3971
3972 3973
3974 if (EQ (face, Qdefault))
3975 {
3976 struct face_cache *c = FRAME_FACE_CACHE (f);
3977 struct face *newface, *oldface = FACE_FROM_ID (f, DEFAULT_FACE_ID);
3978 Lisp_Object attrs[LFACE_VECTOR_SIZE];
3979
3980
3981 if (oldface)
3982 {
3983 3984
3985 bcopy (oldface->lface, attrs, sizeof attrs);
3986 merge_face_vectors (f, lvec, attrs, 0);
3987 bcopy (attrs, lvec, sizeof attrs);
3988 newface = realize_face (c, lvec, DEFAULT_FACE_ID);
3989
3990 if ((! UNSPECIFIEDP (gvec[LFACE_FAMILY_INDEX])
3991 || ! UNSPECIFIEDP (gvec[LFACE_FOUNDRY_INDEX])
3992 || ! UNSPECIFIEDP (gvec[LFACE_HEIGHT_INDEX])
3993 || ! UNSPECIFIEDP (gvec[LFACE_WEIGHT_INDEX])
3994 || ! UNSPECIFIEDP (gvec[LFACE_SLANT_INDEX])
3995 || ! UNSPECIFIEDP (gvec[LFACE_SWIDTH_INDEX])
3996 || ! UNSPECIFIEDP (gvec[LFACE_FONT_INDEX]))
3997 && newface->font)
3998 {
3999 Lisp_Object name = newface->font->props[FONT_NAME_INDEX];
4000 Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, name),
4001 Qnil));
4002 }
4003 }
4004 }
4005
4006 return Qnil;
4007 }
4008
4009
4010 4011 4012 4013
4014
4015 DEFUN ("face-font", Fface_font, Sface_font, 1, 3, 0,
4016 doc: 4017 4018 4019 4020 4021 4022 4023 4024 )
4025 (face, frame, character)
4026 Lisp_Object face, frame, character;
4027 {
4028 if (EQ (frame, Qt))
4029 {
4030 Lisp_Object result = Qnil;
4031 Lisp_Object lface = lface_from_face_name (NULL, face, 1);
4032
4033 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface))
4034 && !EQ (LFACE_WEIGHT (lface), Qnormal))
4035 result = Fcons (Qbold, result);
4036
4037 if (!UNSPECIFIEDP (LFACE_SLANT (lface))
4038 && !EQ (LFACE_SLANT (lface), Qnormal))
4039 result = Fcons (Qitalic, result);
4040
4041 return result;
4042 }
4043 else
4044 {
4045 struct frame *f = frame_or_selected_frame (frame, 1);
4046 int face_id = lookup_named_face (f, face, 1);
4047 struct face *face = FACE_FROM_ID (f, face_id);
4048
4049 if (! face)
4050 return Qnil;
4051 #ifdef HAVE_WINDOW_SYSTEM
4052 if (FRAME_WINDOW_P (f) && !NILP (character))
4053 {
4054 CHECK_CHARACTER (character);
4055 face_id = FACE_FOR_CHAR (f, face, XINT (character), -1, Qnil);
4056 face = FACE_FROM_ID (f, face_id);
4057 }
4058 return (face->font
4059 ? face->font->props[FONT_NAME_INDEX]
4060 : Qnil);
4061 #else
4062 return build_string (FRAME_MSDOS_P (f)
4063 ? "ms-dos"
4064 : FRAME_W32_P (f) ? "w32term"
4065 :"tty");
4066 #endif
4067 }
4068 }
4069
4070
4071 4072 4073
4074
4075 static INLINE int
4076 face_attr_equal_p (v1, v2)
4077 Lisp_Object v1, v2;
4078 {
4079 4080
4081 if (XTYPE (v1) != XTYPE (v2))
4082 return 0;
4083
4084 if (EQ (v1, v2))
4085 return 1;
4086
4087 switch (XTYPE (v1))
4088 {
4089 case Lisp_String:
4090 if (SBYTES (v1) != SBYTES (v2))
4091 return 0;
4092
4093 return bcmp (SDATA (v1), SDATA (v2), SBYTES (v1)) == 0;
4094
4095 case_Lisp_Int:
4096 case Lisp_Symbol:
4097 return 0;
4098
4099 default:
4100 return !NILP (Fequal (v1, v2));
4101 }
4102 }
4103
4104
4105 4106 4107
4108
4109 static INLINE int
4110 lface_equal_p (v1, v2)
4111 Lisp_Object *v1, *v2;
4112 {
4113 int i, equal_p = 1;
4114
4115 for (i = 1; i < LFACE_VECTOR_SIZE && equal_p; ++i)
4116 equal_p = face_attr_equal_p (v1[i], v2[i]);
4117
4118 return equal_p;
4119 }
4120
4121
4122 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p,
4123 Sinternal_lisp_face_equal_p, 2, 3, 0,
4124 doc: 4125 4126 4127 )
4128 (face1, face2, frame)
4129 Lisp_Object face1, face2, frame;
4130 {
4131 int equal_p;
4132 struct frame *f;
4133 Lisp_Object lface1, lface2;
4134
4135 if (EQ (frame, Qt))
4136 f = NULL;
4137 else
4138 4139 4140 4141
4142 f = frame_or_selected_frame (frame, 2);
4143
4144 lface1 = lface_from_face_name (f, face1, 1);
4145 lface2 = lface_from_face_name (f, face2, 1);
4146 equal_p = lface_equal_p (XVECTOR (lface1)->contents,
4147 XVECTOR (lface2)->contents);
4148 return equal_p ? Qt : Qnil;
4149 }
4150
4151
4152 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p,
4153 Sinternal_lisp_face_empty_p, 1, 2, 0,
4154 doc: 4155 4156 4157 )
4158 (face, frame)
4159 Lisp_Object face, frame;
4160 {
4161 struct frame *f;
4162 Lisp_Object lface;
4163 int i;
4164
4165 if (NILP (frame))
4166 frame = selected_frame;
4167 CHECK_LIVE_FRAME (frame);
4168 f = XFRAME (frame);
4169
4170 if (EQ (frame, Qt))
4171 lface = lface_from_face_name (NULL, face, 1);
4172 else
4173 lface = lface_from_face_name (f, face, 1);
4174
4175 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
4176 if (!UNSPECIFIEDP (AREF (lface, i)))
4177 break;
4178
4179 return i == LFACE_VECTOR_SIZE ? Qt : Qnil;
4180 }
4181
4182
4183 DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
4184 0, 1, 0,
4185 doc: 4186 )
4187 (frame)
4188 Lisp_Object frame;
4189 {
4190 struct frame *f = frame_or_selected_frame (frame, 0);
4191 return f->face_alist;
4192 }
4193
4194
4195 4196
4197
4198 static INLINE unsigned
4199 hash_string_case_insensitive (string)
4200 Lisp_Object string;
4201 {
4202 const unsigned char *s;
4203 unsigned hash = 0;
4204 xassert (STRINGP (string));
4205 for (s = SDATA (string); *s; ++s)
4206 hash = (hash << 1) ^ tolower (*s);
4207 return hash;
4208 }
4209
4210
4211
4212
4213 static INLINE unsigned
4214 lface_hash (v)
4215 Lisp_Object *v;
4216 {
4217 return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX])
4218 ^ hash_string_case_insensitive (v[LFACE_FOUNDRY_INDEX])
4219 ^ hash_string_case_insensitive (v[LFACE_FOREGROUND_INDEX])
4220 ^ hash_string_case_insensitive (v[LFACE_BACKGROUND_INDEX])
4221 ^ XHASH (v[LFACE_WEIGHT_INDEX])
4222 ^ XHASH (v[LFACE_SLANT_INDEX])
4223 ^ XHASH (v[LFACE_SWIDTH_INDEX])
4224 ^ XHASH (v[LFACE_HEIGHT_INDEX]));
4225 }
4226
4227
4228 4229 4230 4231
4232
4233 static INLINE int
4234 lface_same_font_attributes_p (lface1, lface2)
4235 Lisp_Object *lface1, *lface2;
4236 {
4237 xassert (lface_fully_specified_p (lface1)
4238 && lface_fully_specified_p (lface2));
4239 return (xstrcasecmp (SDATA (lface1[LFACE_FAMILY_INDEX]),
4240 SDATA (lface2[LFACE_FAMILY_INDEX])) == 0
4241 && xstrcasecmp (SDATA (lface1[LFACE_FOUNDRY_INDEX]),
4242 SDATA (lface2[LFACE_FOUNDRY_INDEX])) == 0
4243 && EQ (lface1[LFACE_HEIGHT_INDEX], lface2[LFACE_HEIGHT_INDEX])
4244 && EQ (lface1[LFACE_SWIDTH_INDEX], lface2[LFACE_SWIDTH_INDEX])
4245 && EQ (lface1[LFACE_WEIGHT_INDEX], lface2[LFACE_WEIGHT_INDEX])
4246 && EQ (lface1[LFACE_SLANT_INDEX], lface2[LFACE_SLANT_INDEX])
4247 && EQ (lface1[LFACE_FONT_INDEX], lface2[LFACE_FONT_INDEX])
4248 && (EQ (lface1[LFACE_FONTSET_INDEX], lface2[LFACE_FONTSET_INDEX])
4249 || (STRINGP (lface1[LFACE_FONTSET_INDEX])
4250 && STRINGP (lface2[LFACE_FONTSET_INDEX])
4251 && ! xstrcasecmp (SDATA (lface1[LFACE_FONTSET_INDEX]),
4252 SDATA (lface2[LFACE_FONTSET_INDEX]))))
4253 );
4254 }
4255
4256
4257
4258 4259 4260
4261
4262 4263
4264
4265 static struct face *
4266 make_realized_face (attr)
4267 Lisp_Object *attr;
4268 {
4269 struct face *face = (struct face *) xmalloc (sizeof *face);
4270 bzero (face, sizeof *face);
4271 face->ascii_face = face;
4272 bcopy (attr, face->lface, sizeof face->lface);
4273 return face;
4274 }
4275
4276
4277 4278
4279
4280 void
4281 free_realized_face (f, face)
4282 struct frame *f;
4283 struct face *face;
4284 {
4285 if (face)
4286 {
4287 #ifdef HAVE_WINDOW_SYSTEM
4288 if (FRAME_WINDOW_P (f))
4289 {
4290
4291 if (face->fontset >= 0 && face == face->ascii_face)
4292 free_face_fontset (f, face);
4293 if (face->gc)
4294 {
4295 BLOCK_INPUT;
4296 if (face->font)
4297 font_done_for_face (f, face);
4298 x_free_gc (f, face->gc);
4299 face->gc = 0;
4300 UNBLOCK_INPUT;
4301 }
4302
4303 free_face_colors (f, face);
4304 x_destroy_bitmap (f, face->stipple);
4305 }
4306 #endif
4307
4308 xfree (face);
4309 }
4310 }
4311
4312
4313 4314 4315
4316
4317 void
4318 prepare_face_for_display (f, face)
4319 struct frame *f;
4320 struct face *face;
4321 {
4322 #ifdef HAVE_WINDOW_SYSTEM
4323 xassert (FRAME_WINDOW_P (f));
4324
4325 if (face->gc == 0)
4326 {
4327 XGCValues xgcv;
4328 unsigned long mask = GCForeground | GCBackground | GCGraphicsExposures;
4329
4330 xgcv.foreground = face->foreground;
4331 xgcv.background = face->background;
4332 #ifdef HAVE_X_WINDOWS
4333 xgcv.graphics_exposures = False;
4334 #endif
4335
4336 BLOCK_INPUT;
4337 #ifdef HAVE_X_WINDOWS
4338 if (face->stipple)
4339 {
4340 xgcv.fill_style = FillOpaqueStippled;
4341 xgcv.stipple = x_bitmap_pixmap (f, face->stipple);
4342 mask |= GCFillStyle | GCStipple;
4343 }
4344 #endif
4345 face->gc = x_create_gc (f, mask, &xgcv);
4346 if (face->font)
4347 font_prepare_for_face (f, face);
4348 UNBLOCK_INPUT;
4349 }
4350 #endif
4351 }
4352
4353
4354
4355
4356 static int
4357 color_distance (x, y)
4358 XColor *x, *y;
4359 {
4360 4361 4362 4363 4364 4365 4366 4367 4368
4369
4370 long r = (x->red - y->red) >> 8;
4371 long g = (x->green - y->green) >> 8;
4372 long b = (x->blue - y->blue) >> 8;
4373 long r_mean = (x->red + y->red) >> 9;
4374
4375 return
4376 (((512 + r_mean) * r * r) >> 8)
4377 + 4 * g * g
4378 + (((767 - r_mean) * b * b) >> 8);
4379 }
4380
4381
4382 DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 3, 0,
4383 doc: 4384 4385 4386 )
4387 (color1, color2, frame)
4388 Lisp_Object color1, color2, frame;
4389 {
4390 struct frame *f;
4391 XColor cdef1, cdef2;
4392
4393 if (NILP (frame))
4394 frame = selected_frame;
4395 CHECK_LIVE_FRAME (frame);
4396 f = XFRAME (frame);
4397
4398 if (!(CONSP (color1) && parse_rgb_list (color1, &cdef1))
4399 && !(STRINGP (color1) && defined_color (f, SDATA (color1), &cdef1, 0)))
4400 signal_error ("Invalid color", color1);
4401 if (!(CONSP (color2) && parse_rgb_list (color2, &cdef2))
4402 && !(STRINGP (color2) && defined_color (f, SDATA (color2), &cdef2, 0)))
4403 signal_error ("Invalid color", color2);
4404
4405 return make_number (color_distance (&cdef1, &cdef2));
4406 }
4407
4408
4409 4410 4411
4412
4413
4414
4415 static struct face_cache *
4416 make_face_cache (f)
4417 struct frame *f;
4418 {
4419 struct face_cache *c;
4420 int size;
4421
4422 c = (struct face_cache *) xmalloc (sizeof *c);
4423 bzero (c, sizeof *c);
4424 size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
4425 c->buckets = (struct face **) xmalloc (size);
4426 bzero (c->buckets, size);
4427 c->size = 50;
4428 c->faces_by_id = (struct face **) xmalloc (c->size * sizeof *c->faces_by_id);
4429 c->f = f;
4430 c->menu_face_changed_p = menu_face_changed_default;
4431 return c;
4432 }
4433
4434
4435 4436 4437
4438
4439 static void
4440 clear_face_gcs (c)
4441 struct face_cache *c;
4442 {
4443 if (c && FRAME_WINDOW_P (c->f))
4444 {
4445 #ifdef HAVE_WINDOW_SYSTEM
4446 int i;
4447 for (i = BASIC_FACE_ID_SENTINEL; i < c->used; ++i)
4448 {
4449 struct face *face = c->faces_by_id[i];
4450 if (face && face->gc)
4451 {
4452 BLOCK_INPUT;
4453 if (face->font)
4454 font_done_for_face (c->f, face);
4455 x_free_gc (c->f, face->gc);
4456 face->gc = 0;
4457 UNBLOCK_INPUT;
4458 }
4459 }
4460 #endif
4461 }
4462 }
4463
4464
4465 4466 4467 4468
4469
4470 static void
4471 free_realized_faces (c)
4472 struct face_cache *c;
4473 {
4474 if (c && c->used)
4475 {
4476 int i, size;
4477 struct frame *f = c->f;
4478
4479 4480 4481
4482 BLOCK_INPUT;
4483
4484 for (i = 0; i < c->used; ++i)
4485 {
4486 free_realized_face (f, c->faces_by_id[i]);
4487 c->faces_by_id[i] = NULL;
4488 }
4489
4490 c->used = 0;
4491 size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
4492 bzero (c->buckets, size);
4493
4494 4495 4496 4497
4498 if (WINDOWP (f->root_window))
4499 {
4500 clear_current_matrices (f);
4501 ++windows_or_buffers_changed;
4502 }
4503
4504 UNBLOCK_INPUT;
4505 }
4506 }
4507
4508
4509
4510
4511 void
4512 free_realized_faces_for_fontset (f, fontset)
4513 struct frame *f;
4514 int fontset;
4515 {
4516 struct face_cache *cache = FRAME_FACE_CACHE (f);
4517 struct face *face;
4518 int i;
4519
4520 4521 4522
4523 BLOCK_INPUT;
4524
4525 for (i = 0; i < cache->used; i++)
4526 {
4527 face = cache->faces_by_id[i];
4528 if (face
4529 && face->fontset == fontset)
4530 {
4531 uncache_face (cache, face);
4532 free_realized_face (f, face);
4533 }
4534 }
4535
4536 4537 4538 4539
4540 if (WINDOWP (f->root_window))
4541 {
4542 clear_current_matrices (f);
4543 ++windows_or_buffers_changed;
4544 }
4545
4546 UNBLOCK_INPUT;
4547 }
4548
4549
4550 4551 4552
4553
4554 void
4555 free_all_realized_faces (frame)
4556 Lisp_Object frame;
4557 {
4558 if (NILP (frame))
4559 {
4560 Lisp_Object rest;
4561 FOR_EACH_FRAME (rest, frame)
4562 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame)));
4563 }
4564 else
4565 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame)));
4566 }
4567
4568
4569
4570
4571 static void
4572 free_face_cache (c)
4573 struct face_cache *c;
4574 {
4575 if (c)
4576 {
4577 free_realized_faces (c);
4578 xfree (c->buckets);
4579 xfree (c->faces_by_id);
4580 xfree (c);
4581 }
4582 }
4583
4584
4585 4586 4587 4588 4589 4590
4591
4592 static void
4593 cache_face (c, face, hash)
4594 struct face_cache *c;
4595 struct face *face;
4596 unsigned hash;
4597 {
4598 int i = hash % FACE_CACHE_BUCKETS_SIZE;
4599
4600 face->hash = hash;
4601
4602 if (face->ascii_face != face)
4603 {
4604 struct face *last = c->buckets[i];
4605 if (last)
4606 {
4607 while (last->next)
4608 last = last->next;
4609 last->next = face;
4610 face->prev = last;
4611 face->next = NULL;
4612 }
4613 else
4614 {
4615 c->buckets[i] = face;
4616 face->prev = face->next = NULL;
4617 }
4618 }
4619 else
4620 {
4621 face->prev = NULL;
4622 face->next = c->buckets[i];
4623 if (face->next)
4624 face->next->prev = face;
4625 c->buckets[i] = face;
4626 }
4627
4628 4629
4630 for (i = 0; i < c->used; ++i)
4631 if (c->faces_by_id[i] == NULL)
4632 break;
4633 face->id = i;
4634
4635
4636 if (i == c->used)
4637 {
4638 if (c->used == c->size)
4639 {
4640 int new_size, sz;
4641 new_size = min (2 * c->size, MAX_FACE_ID);
4642 if (new_size == c->size)
4643 abort ();
4644 sz = new_size * sizeof *c->faces_by_id;
4645 c->faces_by_id = (struct face **) xrealloc (c->faces_by_id, sz);
4646 c->size = new_size;
4647 }
4648 c->used++;
4649 }
4650
4651 #if GLYPH_DEBUG
4652
4653 {
4654 int j, n;
4655 struct face *face;
4656
4657 for (j = n = 0; j < FACE_CACHE_BUCKETS_SIZE; ++j)
4658 for (face = c->buckets[j]; face; face = face->next)
4659 if (face->id == i)
4660 ++n;
4661
4662 xassert (n == 1);
4663 }
4664 #endif
4665
4666 c->faces_by_id[i] = face;
4667 }
4668
4669
4670
4671
4672 static void
4673 uncache_face (c, face)
4674 struct face_cache *c;
4675 struct face *face;
4676 {
4677 int i = face->hash % FACE_CACHE_BUCKETS_SIZE;
4678
4679 if (face->prev)
4680 face->prev->next = face->next;
4681 else
4682 c->buckets[i] = face->next;
4683
4684 if (face->next)
4685 face->next->prev = face->prev;
4686
4687 c->faces_by_id[face->id] = NULL;
4688 if (face->id == c->used)
4689 --c->used;
4690 }
4691
4692
4693 4694 4695 4696
4697
4698 INLINE int
4699 lookup_face (f, attr)
4700 struct frame *f;
4701 Lisp_Object *attr;
4702 {
4703 struct face_cache *cache = FRAME_FACE_CACHE (f);
4704 unsigned hash;
4705 int i;
4706 struct face *face;
4707
4708 xassert (cache != NULL);
4709 check_lface_attrs (attr);
4710
4711
4712 hash = lface_hash (attr);
4713 i = hash % FACE_CACHE_BUCKETS_SIZE;
4714
4715 for (face = cache->buckets[i]; face; face = face->next)
4716 {
4717 if (face->ascii_face != face)
4718 {
4719
4720 face = NULL;
4721 break;
4722 }
4723 if (face->hash == hash
4724 && lface_equal_p (face->lface, attr))
4725 break;
4726 }
4727
4728
4729 if (face == NULL)
4730 face = realize_face (cache, attr, -1);
4731
4732 #if GLYPH_DEBUG
4733 xassert (face == FACE_FROM_ID (f, face->id));
4734 #endif
4735
4736 return face->id;
4737 }
4738
4739 #ifdef HAVE_WINDOW_SYSTEM
4740 4741 4742 4743 4744
4745
4746 int
4747 face_for_font (f, font_object, base_face)
4748 struct frame *f;
4749 Lisp_Object font_object;
4750 struct face *base_face;
4751 {
4752 struct face_cache *cache = FRAME_FACE_CACHE (f);
4753 unsigned hash;
4754 int i;
4755 struct face *face;
4756
4757 xassert (cache != NULL);
4758 base_face = base_face->ascii_face;
4759 hash = lface_hash (base_face->lface);
4760 i = hash % FACE_CACHE_BUCKETS_SIZE;
4761
4762 for (face = cache->buckets[i]; face; face = face->next)
4763 {
4764 if (face->ascii_face == face)
4765 continue;
4766 if (face->ascii_face == base_face
4767 && face->font == (NILP (font_object) ? NULL
4768 : XFONT_OBJECT (font_object))
4769 && lface_equal_p (face->lface, base_face->lface))
4770 return face->id;
4771 }
4772
4773
4774 face = realize_non_ascii_face (f, font_object, base_face);
4775 return face->id;
4776 }
4777 #endif
4778
4779 4780 4781 4782
4783
4784 int
4785 lookup_named_face (f, symbol, signal_p)
4786 struct frame *f;
4787 Lisp_Object symbol;
4788 int signal_p;
4789 {
4790 Lisp_Object attrs[LFACE_VECTOR_SIZE];
4791 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
4792 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4793
4794 if (default_face == NULL)
4795 {
4796 if (!realize_basic_faces (f))
4797 return -1;
4798 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4799 if (default_face == NULL)
4800 abort ();
4801 }
4802
4803 if (! get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
4804 return -1;
4805
4806 bcopy (default_face->lface, attrs, sizeof attrs);
4807 merge_face_vectors (f, symbol_attrs, attrs, 0);
4808
4809 return lookup_face (f, attrs);
4810 }
4811
4812
4813 4814 4815 4816 4817
4818
4819 int
4820 lookup_basic_face (f, face_id)
4821 struct frame *f;
4822 int face_id;
4823 {
4824 Lisp_Object name, mapping;
4825 int remapped_face_id;
4826
4827 if (NILP (Vface_remapping_alist))
4828 return face_id;
4829
4830 switch (face_id)
4831 {
4832 case DEFAULT_FACE_ID: name = Qdefault; break;
4833 case MODE_LINE_FACE_ID: name = Qmode_line; break;
4834 case MODE_LINE_INACTIVE_FACE_ID: name = Qmode_line_inactive; break;
4835 case HEADER_LINE_FACE_ID: name = Qheader_line; break;
4836 case TOOL_BAR_FACE_ID: name = Qtool_bar; break;
4837 case FRINGE_FACE_ID: name = Qfringe; break;
4838 case SCROLL_BAR_FACE_ID: name = Qscroll_bar; break;
4839 case BORDER_FACE_ID: name = Qborder; break;
4840 case CURSOR_FACE_ID: name = Qcursor; break;
4841 case MOUSE_FACE_ID: name = Qmouse; break;
4842 case MENU_FACE_ID: name = Qmenu; break;
4843
4844 default:
4845 abort ();
4846 }
4847
4848 4849 4850
4851 mapping = assq_no_quit (name, Vface_remapping_alist);
4852 if (NILP (mapping))
4853 return face_id;
4854
4855 4856
4857 remapped_face_id = lookup_named_face (f, name, 0);
4858 if (remapped_face_id < 0)
4859 return face_id;
4860
4861 return remapped_face_id;
4862 }
4863
4864
4865 4866
4867
4868 int
4869 ascii_face_of_lisp_face (f, lface_id)
4870 struct frame *f;
4871 int lface_id;
4872 {
4873 int face_id;
4874
4875 if (lface_id >= 0 && lface_id < lface_id_to_name_size)
4876 {
4877 Lisp_Object face_name = lface_id_to_name[lface_id];
4878 face_id = lookup_named_face (f, face_name, 1);
4879 }
4880 else
4881 face_id = -1;
4882
4883 return face_id;
4884 }
4885
4886
4887 4888 4889
4890
4891 int
4892 smaller_face (f, face_id, steps)
4893 struct frame *f;
4894 int face_id, steps;
4895 {
4896 #ifdef HAVE_WINDOW_SYSTEM
4897 struct face *face;
4898 Lisp_Object attrs[LFACE_VECTOR_SIZE];
4899 int pt, last_pt, last_height;
4900 int delta;
4901 int new_face_id;
4902 struct face *new_face;
4903
4904
4905 if (FRAME_TERMCAP_P (f))
4906 return face_id;
4907
4908
4909 delta = steps < 0 ? 5 : -5;
4910 steps = eabs (steps);
4911
4912 face = FACE_FROM_ID (f, face_id);
4913 bcopy (face->lface, attrs, sizeof attrs);
4914 pt = last_pt = XFASTINT (attrs[LFACE_HEIGHT_INDEX]);
4915 new_face_id = face_id;
4916 last_height = FONT_HEIGHT (face->font);
4917
4918 while (steps
4919 && pt + delta > 0
4920
4921 && eabs (last_pt - pt) < 100)
4922 {
4923
4924 pt += delta;
4925 attrs[LFACE_HEIGHT_INDEX] = make_number (pt);
4926 new_face_id = lookup_face (f, attrs);
4927 new_face = FACE_FROM_ID (f, new_face_id);
4928
4929
4930 if ((delta < 0 && FONT_HEIGHT (new_face->font) < last_height)
4931 || (delta > 0 && FONT_HEIGHT (new_face->font) > last_height))
4932 {
4933 --steps;
4934 last_height = FONT_HEIGHT (new_face->font);
4935 last_pt = pt;
4936 }
4937 }
4938
4939 return new_face_id;
4940
4941 #else
4942
4943 return face_id;
4944
4945 #endif
4946 }
4947
4948
4949 4950
4951
4952 int
4953 face_with_height (f, face_id, height)
4954 struct frame *f;
4955 int face_id;
4956 int height;
4957 {
4958 #ifdef HAVE_WINDOW_SYSTEM
4959 struct face *face;
4960 Lisp_Object attrs[LFACE_VECTOR_SIZE];
4961
4962 if (FRAME_TERMCAP_P (f)
4963 || height <= 0)
4964 return face_id;
4965
4966 face = FACE_FROM_ID (f, face_id);
4967 bcopy (face->lface, attrs, sizeof attrs);
4968 attrs[LFACE_HEIGHT_INDEX] = make_number (height);
4969 font_clear_prop (attrs, FONT_SIZE_INDEX);
4970 face_id = lookup_face (f, attrs);
4971 #endif
4972
4973 return face_id;
4974 }
4975
4976
4977 4978 4979 4980 4981 4982
4983
4984 int
4985 lookup_derived_face (f, symbol, face_id, signal_p)
4986 struct frame *f;
4987 Lisp_Object symbol;
4988 int face_id;
4989 int signal_p;
4990 {
4991 Lisp_Object attrs[LFACE_VECTOR_SIZE];
4992 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
4993 struct face *default_face = FACE_FROM_ID (f, face_id);
4994
4995 if (!default_face)
4996 abort ();
4997
4998 if (!get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
4999 return -1;
5000
5001 bcopy (default_face->lface, attrs, sizeof attrs);
5002 merge_face_vectors (f, symbol_attrs, attrs, 0);
5003 return lookup_face (f, attrs);
5004 }
5005
5006 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
5007 Sface_attributes_as_vector, 1, 1, 0,
5008 doc: )
5009 (plist)
5010 Lisp_Object plist;
5011 {
5012 Lisp_Object lface;
5013 lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
5014 Qunspecified);
5015 merge_face_ref (XFRAME (selected_frame), plist, XVECTOR (lface)->contents,
5016 1, 0);
5017 return lface;
5018 }
5019
5020
5021
5022 5023 5024
5025
5026
5027 5028 5029
5030
5031 #define TTY_SAME_COLOR_THRESHOLD 10000
5032
5033 #ifdef HAVE_WINDOW_SYSTEM
5034
5035 5036 5037 5038 5039 5040 5041 5042 5043
5044
5045 static int
5046 x_supports_face_attributes_p (f, attrs, def_face)
5047 struct frame *f;
5048 Lisp_Object *attrs;
5049 struct face *def_face;
5050 {
5051 Lisp_Object *def_attrs = def_face->lface;
5052
5053 5054
5055 if ((!UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
5056 && face_attr_equal_p (attrs[LFACE_UNDERLINE_INDEX],
5057 def_attrs[LFACE_UNDERLINE_INDEX]))
5058 || (!UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
5059 && face_attr_equal_p (attrs[LFACE_INVERSE_INDEX],
5060 def_attrs[LFACE_INVERSE_INDEX]))
5061 || (!UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
5062 && face_attr_equal_p (attrs[LFACE_FOREGROUND_INDEX],
5063 def_attrs[LFACE_FOREGROUND_INDEX]))
5064 || (!UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
5065 && face_attr_equal_p (attrs[LFACE_BACKGROUND_INDEX],
5066 def_attrs[LFACE_BACKGROUND_INDEX]))
5067 || (!UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
5068 && face_attr_equal_p (attrs[LFACE_STIPPLE_INDEX],
5069 def_attrs[LFACE_STIPPLE_INDEX]))
5070 || (!UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
5071 && face_attr_equal_p (attrs[LFACE_OVERLINE_INDEX],
5072 def_attrs[LFACE_OVERLINE_INDEX]))
5073 || (!UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
5074 && face_attr_equal_p (attrs[LFACE_STRIKE_THROUGH_INDEX],
5075 def_attrs[LFACE_STRIKE_THROUGH_INDEX]))
5076 || (!UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
5077 && face_attr_equal_p (attrs[LFACE_BOX_INDEX],
5078 def_attrs[LFACE_BOX_INDEX])))
5079 return 0;
5080
5081 5082
5083 if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
5084 || !UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
5085 || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
5086 || !UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
5087 || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
5088 || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX]))
5089 {
5090 int face_id;
5091 struct face *face;
5092 Lisp_Object merged_attrs[LFACE_VECTOR_SIZE];
5093 int i;
5094
5095 bcopy (def_attrs, merged_attrs, sizeof merged_attrs);
5096
5097 merge_face_vectors (f, attrs, merged_attrs, 0);
5098
5099 face_id = lookup_face (f, merged_attrs);
5100 face = FACE_FROM_ID (f, face_id);
5101
5102 if (! face)
5103 error ("Cannot make face");
5104
5105 5106
5107 if (face->font == def_face->font
5108 || ! face->font)
5109 return 0;
5110 for (i = FONT_TYPE_INDEX; i <= FONT_SIZE_INDEX; i++)
5111 if (! EQ (face->font->props[i], def_face->font->props[i]))
5112 {
5113 Lisp_Object s1, s2;
5114
5115 if (i < FONT_FOUNDRY_INDEX || i > FONT_REGISTRY_INDEX
5116 || face->font->driver->case_sensitive)
5117 return 1;
5118 s1 = SYMBOL_NAME (face->font->props[i]);
5119 s2 = SYMBOL_NAME (def_face->font->props[i]);
5120 if (! EQ (Fcompare_strings (s1, make_number (0), Qnil,
5121 s2, make_number (0), Qnil, Qt), Qt))
5122 return 1;
5123 }
5124 return 0;
5125 }
5126
5127
5128 return 1;
5129 }
5130
5131 #endif
5132
5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147
5148
5149 static int
5150 tty_supports_face_attributes_p (f, attrs, def_face)
5151 struct frame *f;
5152 Lisp_Object *attrs;
5153 struct face *def_face;
5154 {
5155 int weight;
5156 Lisp_Object val, fg, bg;
5157 XColor fg_tty_color, fg_std_color;
5158 XColor bg_tty_color, bg_std_color;
5159 unsigned test_caps = 0;
5160 Lisp_Object *def_attrs = def_face->lface;
5161
5162
5163 5164 5165 5166 5167 5168 5169 5170
5171 if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
5172 || !UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
5173 || !UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
5174 || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
5175 || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
5176 || !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
5177 || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
5178 || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
5179 || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX]))
5180 return 0;
5181
5182
5183
5184
5185
5186 val = attrs[LFACE_WEIGHT_INDEX];
5187 if (!UNSPECIFIEDP (val)
5188 && (weight = FONT_WEIGHT_NAME_NUMERIC (val), weight >= 0))
5189 {
5190 int def_weight = FONT_WEIGHT_NAME_NUMERIC (def_attrs[LFACE_WEIGHT_INDEX]);
5191
5192 if (weight > 100)
5193 {
5194 if (def_weight > 100)
5195 return 0;
5196 test_caps = TTY_CAP_BOLD;
5197 }
5198 else if (weight < 100)
5199 {
5200 if (def_weight < 100)
5201 return 0;
5202 test_caps = TTY_CAP_DIM;
5203 }
5204 else if (def_weight == 100)
5205 return 0;
5206 }
5207
5208
5209 val = attrs[LFACE_UNDERLINE_INDEX];
5210 if (!UNSPECIFIEDP (val))
5211 {
5212 if (STRINGP (val))
5213 return 0;
5214 else if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX]))
5215 return 0;
5216 else
5217 test_caps |= TTY_CAP_UNDERLINE;
5218 }
5219
5220
5221 val = attrs[LFACE_INVERSE_INDEX];
5222 if (!UNSPECIFIEDP (val))
5223 {
5224 if (face_attr_equal_p (val, def_attrs[LFACE_INVERSE_INDEX]))
5225 return 0;
5226 else
5227 test_caps |= TTY_CAP_INVERSE;
5228 }
5229
5230
5231
5232
5233 5234 5235
5236 fg_tty_color.pixel = FACE_TTY_DEFAULT_FG_COLOR;
5237 bg_tty_color.pixel = FACE_TTY_DEFAULT_BG_COLOR;
5238
5239
5240 fg = attrs[LFACE_FOREGROUND_INDEX];
5241 if (STRINGP (fg))
5242 {
5243 Lisp_Object def_fg = def_attrs[LFACE_FOREGROUND_INDEX];
5244
5245 if (face_attr_equal_p (fg, def_fg))
5246 return 0;
5247 else if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color))
5248 return 0;
5249 else if (color_distance (&fg_tty_color, &fg_std_color)
5250 > TTY_SAME_COLOR_THRESHOLD)
5251 return 0;
5252 else
5253
5254 {
5255 XColor def_fg_color;
5256 if (tty_lookup_color (f, def_fg, &def_fg_color, 0)
5257 && (color_distance (&fg_tty_color, &def_fg_color)
5258 <= TTY_SAME_COLOR_THRESHOLD))
5259 return 0;
5260 }
5261 }
5262
5263
5264 bg = attrs[LFACE_BACKGROUND_INDEX];
5265 if (STRINGP (bg))
5266 {
5267 Lisp_Object def_bg = def_attrs[LFACE_BACKGROUND_INDEX];
5268
5269 if (face_attr_equal_p (bg, def_bg))
5270 return 0;
5271 else if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color))
5272 return 0;
5273 else if (color_distance (&bg_tty_color, &bg_std_color)
5274 > TTY_SAME_COLOR_THRESHOLD)
5275 return 0;
5276 else
5277
5278 {
5279 XColor def_bg_color;
5280 if (tty_lookup_color (f, def_bg, &def_bg_color, 0)
5281 && (color_distance (&bg_tty_color, &def_bg_color)
5282 <= TTY_SAME_COLOR_THRESHOLD))
5283 return 0;
5284 }
5285 }
5286
5287 5288 5289 5290
5291 if (STRINGP (fg) && STRINGP (bg))
5292 {
5293 int delta_delta
5294 = (color_distance (&fg_std_color, &bg_std_color)
5295 - color_distance (&fg_tty_color, &bg_tty_color));
5296 if (delta_delta > TTY_SAME_COLOR_THRESHOLD
5297 || delta_delta < -TTY_SAME_COLOR_THRESHOLD)
5298 return 0;
5299 }
5300
5301
5302 5303
5304 if (test_caps != 0 &&
5305 ! tty_capable_p (FRAME_TTY (f), test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
5306 return 0;
5307
5308
5309
5310 return 1;
5311 }
5312
5313
5314 DEFUN ("display-supports-face-attributes-p",
5315 Fdisplay_supports_face_attributes_p, Sdisplay_supports_face_attributes_p,
5316 1, 2, 0,
5317 doc: 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 )
5333 (attributes, display)
5334 Lisp_Object attributes, display;
5335 {
5336 int supports = 0, i;
5337 Lisp_Object frame;
5338 struct frame *f;
5339 struct face *def_face;
5340 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5341
5342 if (noninteractive || !initialized)
5343 5344 5345
5346 return Qnil;
5347
5348 if (NILP (display))
5349 frame = selected_frame;
5350 else if (FRAMEP (display))
5351 frame = display;
5352 else
5353 {
5354
5355 Lisp_Object fl_tail;
5356
5357 frame = Qnil;
5358 for (fl_tail = Vframe_list; CONSP (fl_tail); fl_tail = XCDR (fl_tail))
5359 {
5360 frame = XCAR (fl_tail);
5361 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay,
5362 XFRAME (frame)->param_alist)),
5363 display)))
5364 break;
5365 }
5366 }
5367
5368 CHECK_LIVE_FRAME (frame);
5369 f = XFRAME (frame);
5370
5371 for (i = 0; i < LFACE_VECTOR_SIZE; i++)
5372 attrs[i] = Qunspecified;
5373 merge_face_ref (f, attributes, attrs, 1, 0);
5374
5375 def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5376 if (def_face == NULL)
5377 {
5378 if (! realize_basic_faces (f))
5379 error ("Cannot realize default face");
5380 def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5381 if (def_face == NULL)
5382 abort ();
5383 }
5384
5385
5386 if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
5387 supports = tty_supports_face_attributes_p (f, attrs, def_face);
5388 #ifdef HAVE_WINDOW_SYSTEM
5389 else
5390 supports = x_supports_face_attributes_p (f, attrs, def_face);
5391 #endif
5392
5393 return supports ? Qt : Qnil;
5394 }
5395
5396
5397 5398 5399
5400
5401 DEFUN ("internal-set-font-selection-order",
5402 Finternal_set_font_selection_order,
5403 Sinternal_set_font_selection_order, 1, 1, 0,
5404 doc: 5405 5406 5407 5408 5409 5410 )
5411 (order)
5412 Lisp_Object order;
5413 {
5414 Lisp_Object list;
5415 int i;
5416 int indices[DIM (font_sort_order)];
5417
5418 CHECK_LIST (order);
5419 bzero (indices, sizeof indices);
5420 i = 0;
5421
5422 for (list = order;
5423 CONSP (list) && i < DIM (indices);
5424 list = XCDR (list), ++i)
5425 {
5426 Lisp_Object attr = XCAR (list);
5427 int xlfd;
5428
5429 if (EQ (attr, QCwidth))
5430 xlfd = XLFD_SWIDTH;
5431 else if (EQ (attr, QCheight))
5432 xlfd = XLFD_POINT_SIZE;
5433 else if (EQ (attr, QCweight))
5434 xlfd = XLFD_WEIGHT;
5435 else if (EQ (attr, QCslant))
5436 xlfd = XLFD_SLANT;
5437 else
5438 break;
5439
5440 if (indices[i] != 0)
5441 break;
5442 indices[i] = xlfd;
5443 }
5444
5445 if (!NILP (list) || i != DIM (indices))
5446 signal_error ("Invalid font sort order", order);
5447 for (i = 0; i < DIM (font_sort_order); ++i)
5448 if (indices[i] == 0)
5449 signal_error ("Invalid font sort order", order);
5450
5451 if (bcmp (indices, font_sort_order, sizeof indices) != 0)
5452 {
5453 bcopy (indices, font_sort_order, sizeof font_sort_order);
5454 free_all_realized_faces (Qnil);
5455 }
5456
5457 font_update_sort_order (font_sort_order);
5458
5459 return Qnil;
5460 }
5461
5462
5463 DEFUN ("internal-set-alternative-font-family-alist",
5464 Finternal_set_alternative_font_family_alist,
5465 Sinternal_set_alternative_font_family_alist, 1, 1, 0,
5466 doc: 5467 5468 5469 )
5470 (alist)
5471 Lisp_Object alist;
5472 {
5473 Lisp_Object entry, tail, tail2;
5474
5475 CHECK_LIST (alist);
5476 alist = Fcopy_sequence (alist);
5477 for (tail = alist; CONSP (tail); tail = XCDR (tail))
5478 {
5479 entry = XCAR (tail);
5480 CHECK_LIST (entry);
5481 entry = Fcopy_sequence (entry);
5482 XSETCAR (tail, entry);
5483 for (tail2 = entry; CONSP (tail2); tail2 = XCDR (tail2))
5484 XSETCAR (tail2, Fintern (XCAR (tail2), Qnil));
5485 }
5486
5487 Vface_alternative_font_family_alist = alist;
5488 free_all_realized_faces (Qnil);
5489 return alist;
5490 }
5491
5492
5493 DEFUN ("internal-set-alternative-font-registry-alist",
5494 Finternal_set_alternative_font_registry_alist,
5495 Sinternal_set_alternative_font_registry_alist, 1, 1, 0,
5496 doc: 5497 5498 5499 )
5500 (alist)
5501 Lisp_Object alist;
5502 {
5503 Lisp_Object entry, tail, tail2;
5504
5505 CHECK_LIST (alist);
5506 alist = Fcopy_sequence (alist);
5507 for (tail = alist; CONSP (tail); tail = XCDR (tail))
5508 {
5509 entry = XCAR (tail);
5510 CHECK_LIST (entry);
5511 entry = Fcopy_sequence (entry);
5512 XSETCAR (tail, entry);
5513 for (tail2 = entry; CONSP (tail2); tail2 = XCDR (tail2))
5514 XSETCAR (tail2, Fdowncase (XCAR (tail2)));
5515 }
5516 Vface_alternative_font_registry_alist = alist;
5517 free_all_realized_faces (Qnil);
5518 return alist;
5519 }
5520
5521
5522 #ifdef HAVE_WINDOW_SYSTEM
5523
5524
5525
5526 #define FONT_POINT_SIZE_QUANTUM 5
5527
5528 5529 5530
5531
5532 static int
5533 face_fontset (attrs)
5534 Lisp_Object *attrs;
5535 {
5536 Lisp_Object name;
5537
5538 name = attrs[LFACE_FONTSET_INDEX];
5539 if (!STRINGP (name))
5540 return -1;
5541 return fs_query_fontset (name, 0);
5542 }
5543
5544 #endif
5545
5546
5547
5548 5549 5550
5551
5552 5553 5554
5555
5556 static int
5557 realize_basic_faces (f)
5558 struct frame *f;
5559 {
5560 int success_p = 0;
5561 int count = SPECPDL_INDEX ();
5562
5563 5564
5565 BLOCK_INPUT;
5566 specbind (Qscalable_fonts_allowed, Qt);
5567
5568 if (realize_default_face (f))
5569 {
5570 realize_named_face (f, Qmode_line, MODE_LINE_FACE_ID);
5571 realize_named_face (f, Qmode_line_inactive, MODE_LINE_INACTIVE_FACE_ID);
5572 realize_named_face (f, Qtool_bar, TOOL_BAR_FACE_ID);
5573 realize_named_face (f, Qfringe, FRINGE_FACE_ID);
5574 realize_named_face (f, Qheader_line, HEADER_LINE_FACE_ID);
5575 realize_named_face (f, Qscroll_bar, SCROLL_BAR_FACE_ID);
5576 realize_named_face (f, Qborder, BORDER_FACE_ID);
5577 realize_named_face (f, Qcursor, CURSOR_FACE_ID);
5578 realize_named_face (f, Qmouse, MOUSE_FACE_ID);
5579 realize_named_face (f, Qmenu, MENU_FACE_ID);
5580 realize_named_face (f, Qvertical_border, VERTICAL_BORDER_FACE_ID);
5581
5582
5583 if (FRAME_FACE_CACHE (f)->menu_face_changed_p)
5584 {
5585 FRAME_FACE_CACHE (f)->menu_face_changed_p = 0;
5586 #ifdef USE_X_TOOLKIT
5587 if (FRAME_WINDOW_P (f))
5588 x_update_menu_appearance (f);
5589 #endif
5590 }
5591
5592 success_p = 1;
5593 }
5594
5595 unbind_to (count, Qnil);
5596 UNBLOCK_INPUT;
5597 return success_p;
5598 }
5599
5600
5601 5602 5603
5604
5605 static int
5606 realize_default_face (f)
5607 struct frame *f;
5608 {
5609 struct face_cache *c = FRAME_FACE_CACHE (f);
5610 Lisp_Object lface;
5611 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5612 struct face *face;
5613
5614
5615 lface = lface_from_face_name (f, Qdefault, 0);
5616 if (NILP (lface))
5617 {
5618 Lisp_Object frame;
5619 XSETFRAME (frame, f);
5620 lface = Finternal_make_lisp_face (Qdefault, frame);
5621 }
5622
5623 #ifdef HAVE_WINDOW_SYSTEM
5624 if (FRAME_WINDOW_P (f))
5625 {
5626 Lisp_Object font_object;
5627
5628 XSETFONT (font_object, FRAME_FONT (f));
5629 set_lface_from_font (f, lface, font_object, f->default_face_done_p);
5630 LFACE_FONTSET (lface) = fontset_name (FRAME_FONTSET (f));
5631 f->default_face_done_p = 1;
5632 }
5633 #endif
5634
5635 if (!FRAME_WINDOW_P (f))
5636 {
5637 LFACE_FAMILY (lface) = build_string ("default");
5638 LFACE_FOUNDRY (lface) = LFACE_FAMILY (lface);
5639 LFACE_SWIDTH (lface) = Qnormal;
5640 LFACE_HEIGHT (lface) = make_number (1);
5641 if (UNSPECIFIEDP (LFACE_WEIGHT (lface)))
5642 LFACE_WEIGHT (lface) = Qnormal;
5643 if (UNSPECIFIEDP (LFACE_SLANT (lface)))
5644 LFACE_SLANT (lface) = Qnormal;
5645 if (UNSPECIFIEDP (LFACE_FONTSET (lface)))
5646 LFACE_FONTSET (lface) = Qnil;
5647 }
5648
5649 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface)))
5650 LFACE_UNDERLINE (lface) = Qnil;
5651
5652 if (UNSPECIFIEDP (LFACE_OVERLINE (lface)))
5653 LFACE_OVERLINE (lface) = Qnil;
5654
5655 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface)))
5656 LFACE_STRIKE_THROUGH (lface) = Qnil;
5657
5658 if (UNSPECIFIEDP (LFACE_BOX (lface)))
5659 LFACE_BOX (lface) = Qnil;
5660
5661 if (UNSPECIFIEDP (LFACE_INVERSE (lface)))
5662 LFACE_INVERSE (lface) = Qnil;
5663
5664 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface)))
5665 {
5666 5667
5668 Lisp_Object color = Fassq (Qforeground_color, f->param_alist);
5669
5670 if (CONSP (color) && STRINGP (XCDR (color)))
5671 LFACE_FOREGROUND (lface) = XCDR (color);
5672 else if (FRAME_WINDOW_P (f))
5673 return 0;
5674 else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
5675 LFACE_FOREGROUND (lface) = build_string (unspecified_fg);
5676 else
5677 abort ();
5678 }
5679
5680 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface)))
5681 {
5682 5683
5684 Lisp_Object color = Fassq (Qbackground_color, f->param_alist);
5685 if (CONSP (color) && STRINGP (XCDR (color)))
5686 LFACE_BACKGROUND (lface) = XCDR (color);
5687 else if (FRAME_WINDOW_P (f))
5688 return 0;
5689 else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
5690 LFACE_BACKGROUND (lface) = build_string (unspecified_bg);
5691 else
5692 abort ();
5693 }
5694
5695 if (UNSPECIFIEDP (LFACE_STIPPLE (lface)))
5696 LFACE_STIPPLE (lface) = Qnil;
5697
5698
5699 xassert (lface_fully_specified_p (XVECTOR (lface)->contents));
5700 check_lface (lface);
5701 bcopy (XVECTOR (lface)->contents, attrs, sizeof attrs);
5702 face = realize_face (c, attrs, DEFAULT_FACE_ID);
5703
5704 #ifdef HAVE_WINDOW_SYSTEM
5705 #ifdef HAVE_X_WINDOWS
5706 if (FRAME_X_P (f) && face->font != FRAME_FONT (f))
5707 {
5708 5709
5710 if (!face->font)
5711 return 0;
5712
5713 5714 5715 5716
5717 x_set_font (f, LFACE_FONT (lface), Qnil);
5718 }
5719 #endif
5720 #endif
5721 return 1;
5722 }
5723
5724
5725 5726 5727
5728
5729 static void
5730 realize_named_face (f, symbol, id)
5731 struct frame *f;
5732 Lisp_Object symbol;
5733 int id;
5734 {
5735 struct face_cache *c = FRAME_FACE_CACHE (f);
5736 Lisp_Object lface = lface_from_face_name (f, symbol, 0);
5737 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5738 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
5739 struct face *new_face;
5740
5741
5742 get_lface_attributes_no_remap (f, Qdefault, attrs, 1);
5743 check_lface_attrs (attrs);
5744 xassert (lface_fully_specified_p (attrs));
5745
5746
5747 if (NILP (lface))
5748 {
5749 Lisp_Object frame;
5750 XSETFRAME (frame, f);
5751 lface = Finternal_make_lisp_face (symbol, frame);
5752 }
5753
5754
5755 get_lface_attributes_no_remap (f, symbol, symbol_attrs, 1);
5756 merge_face_vectors (f, symbol_attrs, attrs, 0);
5757
5758
5759 new_face = realize_face (c, attrs, id);
5760 }
5761
5762
5763 5764 5765 5766
5767
5768 static struct face *
5769 realize_face (cache, attrs, former_face_id)
5770 struct face_cache *cache;
5771 Lisp_Object *attrs;
5772 int former_face_id;
5773 {
5774 struct face *face;
5775
5776
5777 xassert (cache != NULL);
5778 check_lface_attrs (attrs);
5779
5780 if (former_face_id >= 0 && cache->used > former_face_id)
5781 {
5782
5783 struct face *former_face = cache->faces_by_id[former_face_id];
5784 uncache_face (cache, former_face);
5785 free_realized_face (cache->f, former_face);
5786 }
5787
5788 if (FRAME_WINDOW_P (cache->f))
5789 face = realize_x_face (cache, attrs);
5790 else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f))
5791 face = realize_tty_face (cache, attrs);
5792 else if (FRAME_INITIAL_P (cache->f))
5793 {
5794
5795 face = make_realized_face (attrs);
5796 }
5797 else
5798 abort ();
5799
5800
5801 cache_face (cache, face, lface_hash (attrs));
5802 return face;
5803 }
5804
5805
5806 #ifdef HAVE_WINDOW_SYSTEM
5807 5808 5809 5810
5811
5812 static struct face *
5813 realize_non_ascii_face (f, font_object, base_face)
5814 struct frame *f;
5815 Lisp_Object font_object;
5816 struct face *base_face;
5817 {
5818 struct face_cache *cache = FRAME_FACE_CACHE (f);
5819 struct face *face;
5820
5821 face = (struct face *) xmalloc (sizeof *face);
5822 *face = *base_face;
5823 face->gc = 0;
5824 face->extra = NULL;
5825 face->overstrike
5826 = (! NILP (font_object)
5827 && FONT_WEIGHT_NAME_NUMERIC (face->lface[LFACE_WEIGHT_INDEX]) > 100
5828 && FONT_WEIGHT_NUMERIC (font_object) <= 100);
5829
5830
5831 face->colors_copied_bitwise_p = 1;
5832 face->font = NILP (font_object) ? NULL : XFONT_OBJECT (font_object);
5833 face->gc = 0;
5834
5835 cache_face (cache, face, face->hash);
5836
5837 return face;
5838 }
5839 #endif
5840
5841
5842 5843 5844 5845 5846 5847
5848
5849 static struct face *
5850 realize_x_face (cache, attrs)
5851 struct face_cache *cache;
5852 Lisp_Object *attrs;
5853 {
5854 struct face *face = NULL;
5855 #ifdef HAVE_WINDOW_SYSTEM
5856 struct face *default_face;
5857 struct frame *f;
5858 Lisp_Object stipple, overline, strike_through, box;
5859
5860 xassert (FRAME_WINDOW_P (cache->f));
5861
5862
5863 face = make_realized_face (attrs);
5864 face->ascii_face = face;
5865
5866 f = cache->f;
5867
5868 5869
5870 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5871 if (default_face
5872 && lface_same_font_attributes_p (default_face->lface, attrs))
5873 {
5874 face->font = default_face->font;
5875 face->fontset
5876 = make_fontset_for_ascii_face (f, default_face->fontset, face);
5877 }
5878 else
5879 {
5880 5881 5882 5883 5884 5885
5886 int fontset = face_fontset (attrs);
5887
5888 5889 5890 5891
5892 if (fontset == -1)
5893 {
5894 if (default_face)
5895 fontset = default_face->fontset;
5896 if (fontset == -1)
5897 abort ();
5898 }
5899 if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
5900 attrs[LFACE_FONT_INDEX]
5901 = font_load_for_lface (f, attrs, attrs[LFACE_FONT_INDEX]);
5902 if (FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
5903 {
5904 face->font = XFONT_OBJECT (attrs[LFACE_FONT_INDEX]);
5905 face->fontset = make_fontset_for_ascii_face (f, fontset, face);
5906 }
5907 else
5908 {
5909 face->font = NULL;
5910 face->fontset = -1;
5911 }
5912 }
5913
5914 if (face->font
5915 && FONT_WEIGHT_NAME_NUMERIC (attrs[LFACE_WEIGHT_INDEX]) > 100
5916 && FONT_WEIGHT_NUMERIC (attrs[LFACE_FONT_INDEX]) <= 100)
5917 face->overstrike = 1;
5918
5919
5920
5921 load_face_colors (f, face, attrs);
5922
5923
5924 box = attrs[LFACE_BOX_INDEX];
5925 if (STRINGP (box))
5926 {
5927 5928
5929 face->box_color = load_color (f, face, attrs[LFACE_BOX_INDEX],
5930 LFACE_BOX_INDEX);
5931 face->box = FACE_SIMPLE_BOX;
5932 face->box_line_width = 1;
5933 }
5934 else if (INTEGERP (box))
5935 {
5936 5937
5938 xassert (XINT (box) != 0);
5939 face->box = FACE_SIMPLE_BOX;
5940 face->box_line_width = XINT (box);
5941 face->box_color = face->foreground;
5942 face->box_color_defaulted_p = 1;
5943 }
5944 else if (CONSP (box))
5945 {
5946 5947
5948 face->box = FACE_SIMPLE_BOX;
5949 face->box_color = face->foreground;
5950 face->box_color_defaulted_p = 1;
5951 face->box_line_width = 1;
5952
5953 while (CONSP (box))
5954 {
5955 Lisp_Object keyword, value;
5956
5957 keyword = XCAR (box);
5958 box = XCDR (box);
5959
5960 if (!CONSP (box))
5961 break;
5962 value = XCAR (box);
5963 box = XCDR (box);
5964
5965 if (EQ (keyword, QCline_width))
5966 {
5967 if (INTEGERP (value) && XINT (value) != 0)
5968 face->box_line_width = XINT (value);
5969 }
5970 else if (EQ (keyword, QCcolor))
5971 {
5972 if (STRINGP (value))
5973 {
5974 face->box_color = load_color (f, face, value,
5975 LFACE_BOX_INDEX);
5976 face->use_box_color_for_shadows_p = 1;
5977 }
5978 }
5979 else if (EQ (keyword, QCstyle))
5980 {
5981 if (EQ (value, Qreleased_button))
5982 face->box = FACE_RAISED_BOX;
5983 else if (EQ (value, Qpressed_button))
5984 face->box = FACE_SUNKEN_BOX;
5985 }
5986 }
5987 }
5988
5989
5990
5991 if (EQ (attrs[LFACE_UNDERLINE_INDEX], Qt))
5992 {
5993
5994 face->underline_p = 1;
5995 face->underline_defaulted_p = 1;
5996 face->underline_color = 0;
5997 }
5998 else if (STRINGP (attrs[LFACE_UNDERLINE_INDEX]))
5999 {
6000
6001 face->underline_p = 1;
6002 face->underline_defaulted_p = 0;
6003 face->underline_color
6004 = load_color (f, face, attrs[LFACE_UNDERLINE_INDEX],
6005 LFACE_UNDERLINE_INDEX);
6006 }
6007 else if (NILP (attrs[LFACE_UNDERLINE_INDEX]))
6008 {
6009 face->underline_p = 0;
6010 face->underline_defaulted_p = 0;
6011 face->underline_color = 0;
6012 }
6013
6014 overline = attrs[LFACE_OVERLINE_INDEX];
6015 if (STRINGP (overline))
6016 {
6017 face->overline_color
6018 = load_color (f, face, attrs[LFACE_OVERLINE_INDEX],
6019 LFACE_OVERLINE_INDEX);
6020 face->overline_p = 1;
6021 }
6022 else if (EQ (overline, Qt))
6023 {
6024 face->overline_color = face->foreground;
6025 face->overline_color_defaulted_p = 1;
6026 face->overline_p = 1;
6027 }
6028
6029 strike_through = attrs[LFACE_STRIKE_THROUGH_INDEX];
6030 if (STRINGP (strike_through))
6031 {
6032 face->strike_through_color
6033 = load_color (f, face, attrs[LFACE_STRIKE_THROUGH_INDEX],
6034 LFACE_STRIKE_THROUGH_INDEX);
6035 face->strike_through_p = 1;
6036 }
6037 else if (EQ (strike_through, Qt))
6038 {
6039 face->strike_through_color = face->foreground;
6040 face->strike_through_color_defaulted_p = 1;
6041 face->strike_through_p = 1;
6042 }
6043
6044 stipple = attrs[LFACE_STIPPLE_INDEX];
6045 if (!NILP (stipple))
6046 face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h);
6047 #endif
6048
6049 return face;
6050 }
6051
6052
6053 6054 6055 6056
6057
6058 static void
6059 map_tty_color (f, face, idx, defaulted)
6060 struct frame *f;
6061 struct face *face;
6062 enum lface_attribute_index idx;
6063 int *defaulted;
6064 {
6065 Lisp_Object frame, color, def;
6066 int foreground_p = idx == LFACE_FOREGROUND_INDEX;
6067 unsigned long default_pixel, default_other_pixel, pixel;
6068
6069 xassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
6070
6071 if (foreground_p)
6072 {
6073 pixel = default_pixel = FACE_TTY_DEFAULT_FG_COLOR;
6074 default_other_pixel = FACE_TTY_DEFAULT_BG_COLOR;
6075 }
6076 else
6077 {
6078 pixel = default_pixel = FACE_TTY_DEFAULT_BG_COLOR;
6079 default_other_pixel = FACE_TTY_DEFAULT_FG_COLOR;
6080 }
6081
6082 XSETFRAME (frame, f);
6083 color = face->lface[idx];
6084
6085 if (STRINGP (color)
6086 && SCHARS (color)
6087 && CONSP (Vtty_defined_color_alist)
6088 && (def = assq_no_quit (color, call1 (Qtty_color_alist, frame)),
6089 CONSP (def)))
6090 {
6091 6092
6093 pixel = XINT (XCAR (XCDR (def)));
6094 }
6095
6096 if (pixel == default_pixel && STRINGP (color))
6097 {
6098 pixel = load_color (f, face, color, idx);
6099
6100 #ifdef MSDOS
6101 6102
6103 if (FRAME_MSDOS_P (f))
6104 {
6105 if (pixel == default_pixel
6106 || pixel == FACE_TTY_DEFAULT_COLOR)
6107 {
6108 if (foreground_p)
6109 pixel = FRAME_FOREGROUND_PIXEL (f);
6110 else
6111 pixel = FRAME_BACKGROUND_PIXEL (f);
6112 face->lface[idx] = tty_color_name (f, pixel);
6113 *defaulted = 1;
6114 }
6115 else if (pixel == default_other_pixel)
6116 {
6117 if (foreground_p)
6118 pixel = FRAME_BACKGROUND_PIXEL (f);
6119 else
6120 pixel = FRAME_FOREGROUND_PIXEL (f);
6121 face->lface[idx] = tty_color_name (f, pixel);
6122 *defaulted = 1;
6123 }
6124 }
6125 #endif
6126 }
6127
6128 if (foreground_p)
6129 face->foreground = pixel;
6130 else
6131 face->background = pixel;
6132 }
6133
6134
6135 6136 6137
6138
6139 static struct face *
6140 realize_tty_face (cache, attrs)
6141 struct face_cache *cache;
6142 Lisp_Object *attrs;
6143 {
6144 struct face *face;
6145 int weight, slant;
6146 int face_colors_defaulted = 0;
6147 struct frame *f = cache->f;
6148
6149
6150 xassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f));
6151
6152
6153 face = make_realized_face (attrs);
6154 #if 0
6155 face->font_name = FRAME_MSDOS_P (cache->f) ? "ms-dos" : "tty";
6156 #endif
6157
6158 6159 6160
6161 weight = FONT_WEIGHT_NAME_NUMERIC (attrs[LFACE_WEIGHT_INDEX]);
6162 slant = FONT_SLANT_NAME_NUMERIC (attrs[LFACE_SLANT_INDEX]);
6163 if (weight > 100)
6164 face->tty_bold_p = 1;
6165 if (weight < 100 || slant != 100)
6166 face->tty_dim_p = 1;
6167 if (!NILP (attrs[LFACE_UNDERLINE_INDEX]))
6168 face->tty_underline_p = 1;
6169 if (!NILP (attrs[LFACE_INVERSE_INDEX]))
6170 face->tty_reverse_p = 1;
6171
6172
6173 map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
6174 map_tty_color (f, face, LFACE_BACKGROUND_INDEX, &face_colors_defaulted);
6175
6176 6177 6178
6179 if (face->tty_reverse_p && !face_colors_defaulted)
6180 {
6181 unsigned long tem = face->foreground;
6182 face->foreground = face->background;
6183 face->background = tem;
6184 }
6185
6186 if (tty_suppress_bold_inverse_default_colors_p
6187 && face->tty_bold_p
6188 && face->background == FACE_TTY_DEFAULT_FG_COLOR
6189 && face->foreground == FACE_TTY_DEFAULT_BG_COLOR)
6190 face->tty_bold_p = 0;
6191
6192 return face;
6193 }
6194
6195
6196 DEFUN ("tty-suppress-bold-inverse-default-colors",
6197 Ftty_suppress_bold_inverse_default_colors,
6198 Stty_suppress_bold_inverse_default_colors, 1, 1, 0,
6199 doc: 6200 6201 6202 6203 6204 )
6205 (suppress)
6206 Lisp_Object suppress;
6207 {
6208 tty_suppress_bold_inverse_default_colors_p = !NILP (suppress);
6209 ++face_change_count;
6210 return suppress;
6211 }
6212
6213
6214
6215 6216 6217
6218
6219 6220
6221
6222 int
6223 compute_char_face (f, ch, prop)
6224 struct frame *f;
6225 int ch;
6226 Lisp_Object prop;
6227 {
6228 int face_id;
6229
6230 if (NILP (current_buffer->enable_multibyte_characters))
6231 ch = 0;
6232
6233 if (NILP (prop))
6234 {
6235 struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
6236 face_id = FACE_FOR_CHAR (f, face, ch, -1, Qnil);
6237 }
6238 else
6239 {
6240 Lisp_Object attrs[LFACE_VECTOR_SIZE];
6241 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
6242 bcopy (default_face->lface, attrs, sizeof attrs);
6243 merge_face_ref (f, prop, attrs, 1, 0);
6244 face_id = lookup_face (f, attrs);
6245 }
6246
6247 return face_id;
6248 }
6249
6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266
6267
6268 int
6269 face_at_buffer_position (w, pos, region_beg, region_end,
6270 endptr, limit, mouse, base_face_id)
6271 struct window *w;
6272 EMACS_INT pos;
6273 EMACS_INT region_beg, region_end;
6274 EMACS_INT *endptr;
6275 EMACS_INT limit;
6276 int mouse;
6277 int base_face_id;
6278 {
6279 struct frame *f = XFRAME (w->frame);
6280 Lisp_Object attrs[LFACE_VECTOR_SIZE];
6281 Lisp_Object prop, position;
6282 int i, noverlays;
6283 Lisp_Object *overlay_vec;
6284 Lisp_Object frame;
6285 EMACS_INT endpos;
6286 Lisp_Object propname = mouse ? Qmouse_face : Qface;
6287 Lisp_Object limit1, end;
6288 struct face *default_face;
6289
6290 6291
6292
6293
6294 XSETFRAME (frame, f);
6295 XSETFASTINT (position, pos);
6296
6297 endpos = ZV;
6298 if (pos < region_beg && region_beg < endpos)
6299 endpos = region_beg;
6300
6301 6302
6303 prop = Fget_text_property (position, propname, w->buffer);
6304 XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
6305 end = Fnext_single_property_change (position, propname, w->buffer, limit1);
6306 if (INTEGERP (end))
6307 endpos = XINT (end);
6308
6309
6310 {
6311 EMACS_INT next_overlay;
6312
6313 GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay, 0);
6314 if (next_overlay < endpos)
6315 endpos = next_overlay;
6316 }
6317
6318 *endptr = endpos;
6319
6320 default_face = FACE_FROM_ID (f, base_face_id >= 0 ? base_face_id
6321 : NILP (Vface_remapping_alist) ? DEFAULT_FACE_ID
6322 : lookup_basic_face (f, DEFAULT_FACE_ID));
6323
6324
6325 if (noverlays == 0
6326 && NILP (prop)
6327 && !(pos >= region_beg && pos < region_end))
6328 return default_face->id;
6329
6330
6331 bcopy (default_face->lface, attrs, sizeof attrs);
6332
6333
6334 if (!NILP (prop))
6335 merge_face_ref (f, prop, attrs, 1, 0);
6336
6337
6338 noverlays = sort_overlays (overlay_vec, noverlays, w);
6339 for (i = 0; i < noverlays; i++)
6340 {
6341 Lisp_Object oend;
6342 int oendpos;
6343
6344 prop = Foverlay_get (overlay_vec[i], propname);
6345 if (!NILP (prop))
6346 merge_face_ref (f, prop, attrs, 1, 0);
6347
6348 oend = OVERLAY_END (overlay_vec[i]);
6349 oendpos = OVERLAY_POSITION (oend);
6350 if (oendpos < endpos)
6351 endpos = oendpos;
6352 }
6353
6354
6355 if (pos >= region_beg && pos < region_end)
6356 {
6357 merge_named_face (f, Qregion, attrs, 0);
6358
6359 if (region_end < endpos)
6360 endpos = region_end;
6361 }
6362
6363 *endptr = endpos;
6364
6365 6366
6367 return lookup_face (f, attrs);
6368 }
6369
6370 6371 6372 6373 6374
6375
6376 int
6377 face_for_overlay_string (w, pos, region_beg, region_end,
6378 endptr, limit, mouse, overlay)
6379 struct window *w;
6380 EMACS_INT pos;
6381 EMACS_INT region_beg, region_end;
6382 EMACS_INT *endptr;
6383 EMACS_INT limit;
6384 int mouse;
6385 Lisp_Object overlay;
6386 {
6387 struct frame *f = XFRAME (w->frame);
6388 Lisp_Object attrs[LFACE_VECTOR_SIZE];
6389 Lisp_Object prop, position;
6390 Lisp_Object frame;
6391 int endpos;
6392 Lisp_Object propname = mouse ? Qmouse_face : Qface;
6393 Lisp_Object limit1, end;
6394 struct face *default_face;
6395
6396 6397
6398
6399
6400 XSETFRAME (frame, f);
6401 XSETFASTINT (position, pos);
6402
6403 endpos = ZV;
6404 if (pos < region_beg && region_beg < endpos)
6405 endpos = region_beg;
6406
6407 6408
6409 prop = Fget_text_property (position, propname, w->buffer);
6410 XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
6411 end = Fnext_single_property_change (position, propname, w->buffer, limit1);
6412 if (INTEGERP (end))
6413 endpos = XINT (end);
6414
6415 *endptr = endpos;
6416
6417 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
6418
6419
6420 if (NILP (prop)
6421 && !(pos >= region_beg && pos < region_end))
6422 return DEFAULT_FACE_ID;
6423
6424
6425 bcopy (default_face->lface, attrs, sizeof attrs);
6426
6427
6428 if (!NILP (prop))
6429 merge_face_ref (f, prop, attrs, 1, 0);
6430
6431
6432 if (pos >= region_beg && pos < region_end)
6433 {
6434 merge_named_face (f, Qregion, attrs, 0);
6435
6436 if (region_end < endpos)
6437 endpos = region_end;
6438 }
6439
6440 *endptr = endpos;
6441
6442 6443
6444 return lookup_face (f, attrs);
6445 }
6446
6447
6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467
6468
6469 int
6470 face_at_string_position (w, string, pos, bufpos, region_beg,
6471 region_end, endptr, base_face_id, mouse_p)
6472 struct window *w;
6473 Lisp_Object string;
6474 EMACS_INT pos, bufpos;
6475 EMACS_INT region_beg, region_end;
6476 EMACS_INT *endptr;
6477 enum face_id base_face_id;
6478 int mouse_p;
6479 {
6480 Lisp_Object prop, position, end, limit;
6481 struct frame *f = XFRAME (WINDOW_FRAME (w));
6482 Lisp_Object attrs[LFACE_VECTOR_SIZE];
6483 struct face *base_face;
6484 int multibyte_p = STRING_MULTIBYTE (string);
6485 Lisp_Object prop_name = mouse_p ? Qmouse_face : Qface;
6486
6487 6488
6489 XSETFASTINT (position, pos);
6490 prop = Fget_text_property (position, prop_name, string);
6491
6492 6493 6494 6495 6496 6497
6498 XSETFASTINT (limit, SCHARS (string));
6499 end = Fnext_single_property_change (position, prop_name, string, limit);
6500 if (INTEGERP (end))
6501 *endptr = XFASTINT (end);
6502 else
6503 *endptr = -1;
6504
6505 base_face = FACE_FROM_ID (f, base_face_id);
6506 xassert (base_face);
6507
6508 6509
6510 if (NILP (prop)
6511 && (base_face_id != DEFAULT_FACE_ID
6512 6513
6514 || bufpos <= 0
6515 || bufpos < region_beg
6516 || bufpos >= region_end)
6517 && (multibyte_p
6518 6519 6520
6521 || !FRAME_WINDOW_P (f)
6522 || FACE_SUITABLE_FOR_CHAR_P (base_face, 0)))
6523 return base_face->id;
6524
6525
6526 bcopy (base_face->lface, attrs, sizeof attrs);
6527
6528
6529 if (!NILP (prop))
6530 merge_face_ref (f, prop, attrs, 1, 0);
6531
6532
6533 if (bufpos
6534 && bufpos >= region_beg
6535 && bufpos < region_end)
6536 merge_named_face (f, Qregion, attrs, 0);
6537
6538 6539
6540 return lookup_face (f, attrs);
6541 }
6542
6543
6544 6545 6546 6547 6548 6549 6550 6551 6552 6553 6554 6555 6556 6557
6558
6559 int
6560 merge_faces (f, face_name, face_id, base_face_id)
6561 struct frame *f;
6562 Lisp_Object face_name;
6563 int face_id, base_face_id;
6564 {
6565 Lisp_Object attrs[LFACE_VECTOR_SIZE];
6566 struct face *base_face;
6567
6568 base_face = FACE_FROM_ID (f, base_face_id);
6569 if (!base_face)
6570 return base_face_id;
6571
6572 if (EQ (face_name, Qt))
6573 {
6574 if (face_id < 0 || face_id >= lface_id_to_name_size)
6575 return base_face_id;
6576 face_name = lface_id_to_name[face_id];
6577 6578
6579 face_id = lookup_derived_face (f, face_name, base_face_id, 0);
6580 return (face_id >= 0 ? face_id : base_face_id);
6581 }
6582
6583
6584 bcopy (base_face->lface, attrs, sizeof attrs);
6585
6586 if (!NILP (face_name))
6587 {
6588 if (!merge_named_face (f, face_name, attrs, 0))
6589 return base_face_id;
6590 }
6591 else
6592 {
6593 struct face *face;
6594 if (face_id < 0)
6595 return base_face_id;
6596 face = FACE_FROM_ID (f, face_id);
6597 if (!face)
6598 return base_face_id;
6599 merge_face_vectors (f, face->lface, attrs, 0);
6600 }
6601
6602 6603
6604 return lookup_face (f, attrs);
6605 }
6606
6607
6608
6609 #ifndef HAVE_X_WINDOWS
6610 DEFUN ("x-load-color-file", Fx_load_color_file,
6611 Sx_load_color_file, 1, 1, 0,
6612 doc: 6613 6614 6615 6616 )
6617 (filename)
6618 Lisp_Object filename;
6619 {
6620 FILE *fp;
6621 Lisp_Object cmap = Qnil;
6622 Lisp_Object abspath;
6623
6624 CHECK_STRING (filename);
6625 abspath = Fexpand_file_name (filename, Qnil);
6626
6627 fp = fopen (SDATA (filename), "rt");
6628 if (fp)
6629 {
6630 char buf[512];
6631 int red, green, blue;
6632 int num;
6633
6634 BLOCK_INPUT;
6635
6636 while (fgets (buf, sizeof (buf), fp) != NULL) {
6637 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
6638 {
6639 char *name = buf + num;
6640 num = strlen (name) - 1;
6641 if (num >= 0 && name[num] == '\n')
6642 name[num] = 0;
6643 cmap = Fcons (Fcons (build_string (name),
6644 #ifdef WINDOWSNT
6645 make_number (RGB (red, green, blue))),
6646 #else
6647 make_number ((red << 16) | (green << 8) | blue)),
6648 #endif
6649 cmap);
6650 }
6651 }
6652 fclose (fp);
6653
6654 UNBLOCK_INPUT;
6655 }
6656
6657 return cmap;
6658 }
6659 #endif
6660
6661
6662 6663 6664
6665
6666 #if GLYPH_DEBUG
6667
6668
6669
6670 static void
6671 dump_realized_face (face)
6672 struct face *face;
6673 {
6674 fprintf (stderr, "ID: %d\n", face->id);
6675 #ifdef HAVE_X_WINDOWS
6676 fprintf (stderr, "gc: %ld\n", (long) face->gc);
6677 #endif
6678 fprintf (stderr, "foreground: 0x%lx (%s)\n",
6679 face->foreground,
6680 SDATA (face->lface[LFACE_FOREGROUND_INDEX]));
6681 fprintf (stderr, "background: 0x%lx (%s)\n",
6682 face->background,
6683 SDATA (face->lface[LFACE_BACKGROUND_INDEX]));
6684 if (face->font)
6685 fprintf (stderr, "font_name: %s (%s)\n",
6686 SDATA (face->font->props[FONT_NAME_INDEX]),
6687 SDATA (face->lface[LFACE_FAMILY_INDEX]));
6688 #ifdef HAVE_X_WINDOWS
6689 fprintf (stderr, "font = %p\n", face->font);
6690 #endif
6691 fprintf (stderr, "fontset: %d\n", face->fontset);
6692 fprintf (stderr, "underline: %d (%s)\n",
6693 face->underline_p,
6694 SDATA (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX])));
6695 fprintf (stderr, "hash: %d\n", face->hash);
6696 }
6697
6698
6699 DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, doc: )
6700 (n)
6701 Lisp_Object n;
6702 {
6703 if (NILP (n))
6704 {
6705 int i;
6706
6707 fprintf (stderr, "font selection order: ");
6708 for (i = 0; i < DIM (font_sort_order); ++i)
6709 fprintf (stderr, "%d ", font_sort_order[i]);
6710 fprintf (stderr, "\n");
6711
6712 fprintf (stderr, "alternative fonts: ");
6713 debug_print (Vface_alternative_font_family_alist);
6714 fprintf (stderr, "\n");
6715
6716 for (i = 0; i < FRAME_FACE_CACHE (SELECTED_FRAME ())->used; ++i)
6717 Fdump_face (make_number (i));
6718 }
6719 else
6720 {
6721 struct face *face;
6722 CHECK_NUMBER (n);
6723 face = FACE_FROM_ID (SELECTED_FRAME (), XINT (n));
6724 if (face == NULL)
6725 error ("Not a valid face");
6726 dump_realized_face (face);
6727 }
6728
6729 return Qnil;
6730 }
6731
6732
6733 DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
6734 0, 0, 0, doc: )
6735 ()
6736 {
6737 fprintf (stderr, "number of colors = %d\n", ncolors_allocated);
6738 fprintf (stderr, "number of pixmaps = %d\n", npixmaps_allocated);
6739 fprintf (stderr, "number of GCs = %d\n", ngcs);
6740 return Qnil;
6741 }
6742
6743 #endif
6744
6745
6746
6747 6748 6749
6750
6751 void
6752 syms_of_xfaces ()
6753 {
6754 Qface = intern_c_string ("face");
6755 staticpro (&Qface);
6756 Qface_no_inherit = intern_c_string ("face-no-inherit");
6757 staticpro (&Qface_no_inherit);
6758 Qbitmap_spec_p = intern_c_string ("bitmap-spec-p");
6759 staticpro (&Qbitmap_spec_p);
6760 Qframe_set_background_mode = intern_c_string ("frame-set-background-mode");
6761 staticpro (&Qframe_set_background_mode);
6762
6763
6764 QCfamily = intern_c_string (":family");
6765 staticpro (&QCfamily);
6766 QCheight = intern_c_string (":height");
6767 staticpro (&QCheight);
6768 QCweight = intern_c_string (":weight");
6769 staticpro (&QCweight);
6770 QCslant = intern_c_string (":slant");
6771 staticpro (&QCslant);
6772 QCunderline = intern_c_string (":underline");
6773 staticpro (&QCunderline);
6774 QCinverse_video = intern_c_string (":inverse-video");
6775 staticpro (&QCinverse_video);
6776 QCreverse_video = intern_c_string (":reverse-video");
6777 staticpro (&QCreverse_video);
6778 QCforeground = intern_c_string (":foreground");
6779 staticpro (&QCforeground);
6780 QCbackground = intern_c_string (":background");
6781 staticpro (&QCbackground);
6782 QCstipple = intern_c_string (":stipple");
6783 staticpro (&QCstipple);
6784 QCwidth = intern_c_string (":width");
6785 staticpro (&QCwidth);
6786 QCfont = intern_c_string (":font");
6787 staticpro (&QCfont);
6788 QCfontset = intern_c_string (":fontset");
6789 staticpro (&QCfontset);
6790 QCbold = intern_c_string (":bold");
6791 staticpro (&QCbold);
6792 QCitalic = intern_c_string (":italic");
6793 staticpro (&QCitalic);
6794 QCoverline = intern_c_string (":overline");
6795 staticpro (&QCoverline);
6796 QCstrike_through = intern_c_string (":strike-through");
6797 staticpro (&QCstrike_through);
6798 QCbox = intern_c_string (":box");
6799 staticpro (&QCbox);
6800 QCinherit = intern_c_string (":inherit");
6801 staticpro (&QCinherit);
6802
6803
6804 QCcolor = intern_c_string (":color");
6805 staticpro (&QCcolor);
6806 QCline_width = intern_c_string (":line-width");
6807 staticpro (&QCline_width);
6808 QCstyle = intern_c_string (":style");
6809 staticpro (&QCstyle);
6810 Qreleased_button = intern_c_string ("released-button");
6811 staticpro (&Qreleased_button);
6812 Qpressed_button = intern_c_string ("pressed-button");
6813 staticpro (&Qpressed_button);
6814 Qnormal = intern_c_string ("normal");
6815 staticpro (&Qnormal);
6816 Qultra_light = intern_c_string ("ultra-light");
6817 staticpro (&Qultra_light);
6818 Qextra_light = intern_c_string ("extra-light");
6819 staticpro (&Qextra_light);
6820 Qlight = intern_c_string ("light");
6821 staticpro (&Qlight);
6822 Qsemi_light = intern_c_string ("semi-light");
6823 staticpro (&Qsemi_light);
6824 Qsemi_bold = intern_c_string ("semi-bold");
6825 staticpro (&Qsemi_bold);
6826 Qbold = intern_c_string ("bold");
6827 staticpro (&Qbold);
6828 Qextra_bold = intern_c_string ("extra-bold");
6829 staticpro (&Qextra_bold);
6830 Qultra_bold = intern_c_string ("ultra-bold");
6831 staticpro (&Qultra_bold);
6832 Qoblique = intern_c_string ("oblique");
6833 staticpro (&Qoblique);
6834 Qitalic = intern_c_string ("italic");
6835 staticpro (&Qitalic);
6836 Qreverse_oblique = intern_c_string ("reverse-oblique");
6837 staticpro (&Qreverse_oblique);
6838 Qreverse_italic = intern_c_string ("reverse-italic");
6839 staticpro (&Qreverse_italic);
6840 Qultra_condensed = intern_c_string ("ultra-condensed");
6841 staticpro (&Qultra_condensed);
6842 Qextra_condensed = intern_c_string ("extra-condensed");
6843 staticpro (&Qextra_condensed);
6844 Qcondensed = intern_c_string ("condensed");
6845 staticpro (&Qcondensed);
6846 Qsemi_condensed = intern_c_string ("semi-condensed");
6847 staticpro (&Qsemi_condensed);
6848 Qsemi_expanded = intern_c_string ("semi-expanded");
6849 staticpro (&Qsemi_expanded);
6850 Qexpanded = intern_c_string ("expanded");
6851 staticpro (&Qexpanded);
6852 Qextra_expanded = intern_c_string ("extra-expanded");
6853 staticpro (&Qextra_expanded);
6854 Qultra_expanded = intern_c_string ("ultra-expanded");
6855 staticpro (&Qultra_expanded);
6856 Qbackground_color = intern_c_string ("background-color");
6857 staticpro (&Qbackground_color);
6858 Qforeground_color = intern_c_string ("foreground-color");
6859 staticpro (&Qforeground_color);
6860 Qunspecified = intern_c_string ("unspecified");
6861 staticpro (&Qunspecified);
6862 Qignore_defface = intern_c_string (":ignore-defface");
6863 staticpro (&Qignore_defface);
6864
6865 Qface_alias = intern_c_string ("face-alias");
6866 staticpro (&Qface_alias);
6867 Qdefault = intern_c_string ("default");
6868 staticpro (&Qdefault);
6869 Qtool_bar = intern_c_string ("tool-bar");
6870 staticpro (&Qtool_bar);
6871 Qregion = intern_c_string ("region");
6872 staticpro (&Qregion);
6873 Qfringe = intern_c_string ("fringe");
6874 staticpro (&Qfringe);
6875 Qheader_line = intern_c_string ("header-line");
6876 staticpro (&Qheader_line);
6877 Qscroll_bar = intern_c_string ("scroll-bar");
6878 staticpro (&Qscroll_bar);
6879 Qmenu = intern_c_string ("menu");
6880 staticpro (&Qmenu);
6881 Qcursor = intern_c_string ("cursor");
6882 staticpro (&Qcursor);
6883 Qborder = intern_c_string ("border");
6884 staticpro (&Qborder);
6885 Qmouse = intern_c_string ("mouse");
6886 staticpro (&Qmouse);
6887 Qmode_line_inactive = intern_c_string ("mode-line-inactive");
6888 staticpro (&Qmode_line_inactive);
6889 Qvertical_border = intern_c_string ("vertical-border");
6890 staticpro (&Qvertical_border);
6891 Qtty_color_desc = intern_c_string ("tty-color-desc");
6892 staticpro (&Qtty_color_desc);
6893 Qtty_color_standard_values = intern_c_string ("tty-color-standard-values");
6894 staticpro (&Qtty_color_standard_values);
6895 Qtty_color_by_index = intern_c_string ("tty-color-by-index");
6896 staticpro (&Qtty_color_by_index);
6897 Qtty_color_alist = intern_c_string ("tty-color-alist");
6898 staticpro (&Qtty_color_alist);
6899 Qscalable_fonts_allowed = intern_c_string ("scalable-fonts-allowed");
6900 staticpro (&Qscalable_fonts_allowed);
6901
6902 Vparam_value_alist = Fcons (Fcons (Qnil, Qnil), Qnil);
6903 staticpro (&Vparam_value_alist);
6904 Vface_alternative_font_family_alist = Qnil;
6905 staticpro (&Vface_alternative_font_family_alist);
6906 Vface_alternative_font_registry_alist = Qnil;
6907 staticpro (&Vface_alternative_font_registry_alist);
6908
6909 defsubr (&Sinternal_make_lisp_face);
6910 defsubr (&Sinternal_lisp_face_p);
6911 defsubr (&Sinternal_set_lisp_face_attribute);
6912 #ifdef HAVE_WINDOW_SYSTEM
6913 defsubr (&Sinternal_set_lisp_face_attribute_from_resource);
6914 #endif
6915 defsubr (&Scolor_gray_p);
6916 defsubr (&Scolor_supported_p);
6917 #ifndef HAVE_X_WINDOWS
6918 defsubr (&Sx_load_color_file);
6919 #endif
6920 defsubr (&Sface_attribute_relative_p);
6921 defsubr (&Smerge_face_attribute);
6922 defsubr (&Sinternal_get_lisp_face_attribute);
6923 defsubr (&Sinternal_lisp_face_attribute_values);
6924 defsubr (&Sinternal_lisp_face_equal_p);
6925 defsubr (&Sinternal_lisp_face_empty_p);
6926 defsubr (&Sinternal_copy_lisp_face);
6927 defsubr (&Sinternal_merge_in_global_face);
6928 defsubr (&Sface_font);
6929 defsubr (&Sframe_face_alist);
6930 defsubr (&Sdisplay_supports_face_attributes_p);
6931 defsubr (&Scolor_distance);
6932 defsubr (&Sinternal_set_font_selection_order);
6933 defsubr (&Sinternal_set_alternative_font_family_alist);
6934 defsubr (&Sinternal_set_alternative_font_registry_alist);
6935 defsubr (&Sface_attributes_as_vector);
6936 #if GLYPH_DEBUG
6937 defsubr (&Sdump_face);
6938 defsubr (&Sshow_face_resources);
6939 #endif
6940 defsubr (&Sclear_face_cache);
6941 defsubr (&Stty_suppress_bold_inverse_default_colors);
6942
6943 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6944 defsubr (&Sdump_colors);
6945 #endif
6946
6947 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit,
6948 doc: 6949 6950 );
6951 Vfont_list_limit = make_number (DEFAULT_FONT_LIST_LIMIT);
6952
6953 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults,
6954 doc: );
6955 Vface_new_frame_defaults = Qnil;
6956
6957 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple,
6958 doc: 6959 6960 6961 );
6962 Vface_default_stipple = make_pure_c_string ("gray3");
6963
6964 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist,
6965 doc: );
6966 Vtty_defined_color_alist = Qnil;
6967
6968 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed,
6969 doc: 6970 6971 6972 6973 6974 6975 );
6976 Vscalable_fonts_allowed = Qnil;
6977
6978 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts,
6979 doc: 6980 6981 );
6982 Vface_ignored_fonts = Qnil;
6983
6984 DEFVAR_LISP ("face-remapping-alist", &Vface_remapping_alist,
6985 doc: 6986 6987 6988 6989 6990 6991 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 7005 7006 7007 7008 7009 7010 7011 7012 7013 7014 7015 7016 7017 7018 );
7019 Vface_remapping_alist = Qnil;
7020
7021 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist,
7022 doc: 7023 7024 7025 7026 7027 );
7028 Vface_font_rescale_alist = Qnil;
7029
7030 #ifdef HAVE_WINDOW_SYSTEM
7031 defsubr (&Sbitmap_spec_p);
7032 defsubr (&Sx_list_fonts);
7033 defsubr (&Sinternal_face_x_get_resource);
7034 defsubr (&Sx_family_fonts);
7035 #endif
7036 }
7037
7038 7039