comparison src/faces.c @ 440:8de8e3f6228a r21-2-28

Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 3ecd8885ac67
children abe6d1db359e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
55 calling Ffind_face. */ 55 calling Ffind_face. */
56 Lisp_Object Vdefault_face, Vmodeline_face, Vgui_element_face; 56 Lisp_Object Vdefault_face, Vmodeline_face, Vgui_element_face;
57 Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face; 57 Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face;
58 Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face, Vwidget_face; 58 Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face, Vwidget_face;
59 59
60 /* Qdefault, Qhighlight defined in general.c */ 60 /* Qdefault, Qhighlight, Qleft_margin, Qright_margin defined in general.c */
61 Lisp_Object Qmodeline, Qgui_element, Qleft_margin, Qright_margin, Qtext_cursor; 61 Lisp_Object Qmodeline, Qgui_element, Qtext_cursor, Qvertical_divider;
62 Lisp_Object Qvertical_divider;
63 62
64 /* In the old implementation Vface_list was a list of the face names, 63 /* In the old implementation Vface_list was a list of the face names,
65 not the faces themselves. We now distinguish between permanent and 64 not the faces themselves. We now distinguish between permanent and
66 temporary faces. Permanent faces are kept in a regular hash table, 65 temporary faces. Permanent faces are kept in a regular hash table,
67 temporary faces in a weak hash table. */ 66 temporary faces in a weak hash table. */
73 72
74 73
75 static Lisp_Object 74 static Lisp_Object
76 mark_face (Lisp_Object obj) 75 mark_face (Lisp_Object obj)
77 { 76 {
78 struct Lisp_Face *face = XFACE (obj); 77 Lisp_Face *face = XFACE (obj);
79 78
80 mark_object (face->name); 79 mark_object (face->name);
81 mark_object (face->doc_string); 80 mark_object (face->doc_string);
82 81
83 mark_object (face->foreground); 82 mark_object (face->foreground);
98 } 97 }
99 98
100 static void 99 static void
101 print_face (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 100 print_face (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
102 { 101 {
103 struct Lisp_Face *face = XFACE (obj); 102 Lisp_Face *face = XFACE (obj);
104 103
105 if (print_readably) 104 if (print_readably)
106 { 105 {
107 write_c_string ("#s(face name ", printcharfun); 106 write_c_string ("#s(face name ", printcharfun);
108 print_internal (face->name, printcharfun, 1); 107 print_internal (face->name, printcharfun, 1);
128 This isn't concerned with "unspecified" attributes, that's what 127 This isn't concerned with "unspecified" attributes, that's what
129 #'face-differs-from-default-p is for. */ 128 #'face-differs-from-default-p is for. */
130 static int 129 static int
131 face_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 130 face_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
132 { 131 {
133 struct Lisp_Face *f1 = XFACE (obj1); 132 Lisp_Face *f1 = XFACE (obj1);
134 struct Lisp_Face *f2 = XFACE (obj2); 133 Lisp_Face *f2 = XFACE (obj2);
135 134
136 depth++; 135 depth++;
137 136
138 return 137 return
139 (internal_equal (f1->foreground, f2->foreground, depth) && 138 (internal_equal (f1->foreground, f2->foreground, depth) &&
152 } 151 }
153 152
154 static unsigned long 153 static unsigned long
155 face_hash (Lisp_Object obj, int depth) 154 face_hash (Lisp_Object obj, int depth)
156 { 155 {
157 struct Lisp_Face *f = XFACE (obj); 156 Lisp_Face *f = XFACE (obj);
158 157
159 depth++; 158 depth++;
160 159
161 /* No need to hash all of the elements; that would take too long. 160 /* No need to hash all of the elements; that would take too long.
162 Just hash the most common ones. */ 161 Just hash the most common ones. */
166 } 165 }
167 166
168 static Lisp_Object 167 static Lisp_Object
169 face_getprop (Lisp_Object obj, Lisp_Object prop) 168 face_getprop (Lisp_Object obj, Lisp_Object prop)
170 { 169 {
171 struct Lisp_Face *f = XFACE (obj); 170 Lisp_Face *f = XFACE (obj);
172 171
173 return 172 return
174 (EQ (prop, Qforeground) ? f->foreground : 173 (EQ (prop, Qforeground) ? f->foreground :
175 EQ (prop, Qbackground) ? f->background : 174 EQ (prop, Qbackground) ? f->background :
176 EQ (prop, Qfont) ? f->font : 175 EQ (prop, Qfont) ? f->font :
187 } 186 }
188 187
189 static int 188 static int
190 face_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) 189 face_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
191 { 190 {
192 struct Lisp_Face *f = XFACE (obj); 191 Lisp_Face *f = XFACE (obj);
193 192
194 if (EQ (prop, Qforeground) || 193 if (EQ (prop, Qforeground) ||
195 EQ (prop, Qbackground) || 194 EQ (prop, Qbackground) ||
196 EQ (prop, Qfont) || 195 EQ (prop, Qfont) ||
197 EQ (prop, Qdisplay_table) || 196 EQ (prop, Qdisplay_table) ||
217 } 216 }
218 217
219 static int 218 static int
220 face_remprop (Lisp_Object obj, Lisp_Object prop) 219 face_remprop (Lisp_Object obj, Lisp_Object prop)
221 { 220 {
222 struct Lisp_Face *f = XFACE (obj); 221 Lisp_Face *f = XFACE (obj);
223 222
224 if (EQ (prop, Qforeground) || 223 if (EQ (prop, Qforeground) ||
225 EQ (prop, Qbackground) || 224 EQ (prop, Qbackground) ||
226 EQ (prop, Qfont) || 225 EQ (prop, Qfont) ||
227 EQ (prop, Qdisplay_table) || 226 EQ (prop, Qdisplay_table) ||
244 } 243 }
245 244
246 static Lisp_Object 245 static Lisp_Object
247 face_plist (Lisp_Object obj) 246 face_plist (Lisp_Object obj)
248 { 247 {
249 struct Lisp_Face *face = XFACE (obj); 248 Lisp_Face *face = XFACE (obj);
250 Lisp_Object result = face->plist; 249 Lisp_Object result = face->plist;
251 250
252 result = cons3 (Qreverse, face->reverse, result); 251 result = cons3 (Qreverse, face->reverse, result);
253 result = cons3 (Qblinking, face->blinking, result); 252 result = cons3 (Qblinking, face->blinking, result);
254 result = cons3 (Qdim, face->dim, result); 253 result = cons3 (Qdim, face->dim, result);
263 262
264 return result; 263 return result;
265 } 264 }
266 265
267 static const struct lrecord_description face_description[] = { 266 static const struct lrecord_description face_description[] = {
268 { XD_LISP_OBJECT, offsetof(struct Lisp_Face, name), 2 }, 267 { XD_LISP_OBJECT, offsetof (Lisp_Face, name) },
269 { XD_LISP_OBJECT, offsetof(struct Lisp_Face, foreground), 13 }, 268 { XD_LISP_OBJECT, offsetof (Lisp_Face, doc_string) },
269 { XD_LISP_OBJECT, offsetof (Lisp_Face, foreground) },
270 { XD_LISP_OBJECT, offsetof (Lisp_Face, background) },
271 { XD_LISP_OBJECT, offsetof (Lisp_Face, font) },
272 { XD_LISP_OBJECT, offsetof (Lisp_Face, display_table) },
273 { XD_LISP_OBJECT, offsetof (Lisp_Face, background_pixmap) },
274 { XD_LISP_OBJECT, offsetof (Lisp_Face, underline) },
275 { XD_LISP_OBJECT, offsetof (Lisp_Face, strikethru) },
276 { XD_LISP_OBJECT, offsetof (Lisp_Face, highlight) },
277 { XD_LISP_OBJECT, offsetof (Lisp_Face, dim) },
278 { XD_LISP_OBJECT, offsetof (Lisp_Face, blinking) },
279 { XD_LISP_OBJECT, offsetof (Lisp_Face, reverse) },
280 { XD_LISP_OBJECT, offsetof (Lisp_Face, plist) },
281 { XD_LISP_OBJECT, offsetof (Lisp_Face, charsets_warned_about) },
270 { XD_END } 282 { XD_END }
271 }; 283 };
272 284
273 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face, 285 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face,
274 mark_face, print_face, 0, face_equal, 286 mark_face, print_face, 0, face_equal,
275 face_hash, face_description, face_getprop, 287 face_hash, face_description, face_getprop,
276 face_putprop, face_remprop, 288 face_putprop, face_remprop,
277 face_plist, struct Lisp_Face); 289 face_plist, Lisp_Face);
278 290
279 /************************************************************************/ 291 /************************************************************************/
280 /* face read syntax */ 292 /* face read syntax */
281 /************************************************************************/ 293 /************************************************************************/
282 294
338 /**************************************************************************** 350 /****************************************************************************
339 * utility functions * 351 * utility functions *
340 ****************************************************************************/ 352 ****************************************************************************/
341 353
342 static void 354 static void
343 reset_face (struct Lisp_Face *f) 355 reset_face (Lisp_Face *f)
344 { 356 {
345 f->name = Qnil; 357 f->name = Qnil;
346 f->doc_string = Qnil; 358 f->doc_string = Qnil;
347 f->dirty = 0; 359 f->dirty = 0;
348 f->foreground = Qnil; 360 f->foreground = Qnil;
358 f->reverse = Qnil; 370 f->reverse = Qnil;
359 f->plist = Qnil; 371 f->plist = Qnil;
360 f->charsets_warned_about = Qnil; 372 f->charsets_warned_about = Qnil;
361 } 373 }
362 374
363 static struct Lisp_Face * 375 static Lisp_Face *
364 allocate_face (void) 376 allocate_face (void)
365 { 377 {
366 struct Lisp_Face *result = 378 Lisp_Face *result = alloc_lcrecord_type (Lisp_Face, &lrecord_face);
367 alloc_lcrecord_type (struct Lisp_Face, &lrecord_face);
368 379
369 reset_face (result); 380 reset_face (result);
370 return result; 381 return result;
371 } 382 }
372 383
757 If TEMPORARY is non-nil, this face will cease to exist if not in use. 768 If TEMPORARY is non-nil, this face will cease to exist if not in use.
758 */ 769 */
759 (name, doc_string, temporary)) 770 (name, doc_string, temporary))
760 { 771 {
761 /* This function can GC if initialized is non-zero */ 772 /* This function can GC if initialized is non-zero */
762 struct Lisp_Face *f; 773 Lisp_Face *f;
763 Lisp_Object face; 774 Lisp_Object face;
764 775
765 CHECK_SYMBOL (name); 776 CHECK_SYMBOL (name);
766 if (!NILP (doc_string)) 777 if (!NILP (doc_string))
767 CHECK_STRING (doc_string); 778 CHECK_STRING (doc_string);
1125 { 1136 {
1126 if (charsets[i]) 1137 if (charsets[i])
1127 { 1138 {
1128 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE); 1139 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE);
1129 Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset); 1140 Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset);
1130 struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance); 1141 Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance);
1131 1142
1132 assert (CHARSETP (charset)); 1143 assert (CHARSETP (charset));
1133 assert (FONT_INSTANCEP (font_instance)); 1144 assert (FONT_INSTANCEP (font_instance));
1134 1145
1135 if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent; 1146 if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent;
1677 or makes an already-existing face be exactly like another. 1688 or makes an already-existing face be exactly like another.
1678 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'. 1689 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'.
1679 */ 1690 */
1680 (old_face, new_name, locale, tag_set, exact_p, how_to_add)) 1691 (old_face, new_name, locale, tag_set, exact_p, how_to_add))
1681 { 1692 {
1682 struct Lisp_Face *fold, *fnew; 1693 Lisp_Face *fold, *fnew;
1683 Lisp_Object new_face = Qnil; 1694 Lisp_Object new_face = Qnil;
1684 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 1695 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1685 1696
1686 old_face = Fget_face (old_face); 1697 old_face = Fget_face (old_face);
1687 1698
1739 1750
1740 1751
1741 void 1752 void
1742 syms_of_faces (void) 1753 syms_of_faces (void)
1743 { 1754 {
1744 /* Qdefault & Qwidget defined in general.c */ 1755 /* Qdefault, Qwidget, Qleft_margin, Qright_margin defined in general.c */
1745 defsymbol (&Qmodeline, "modeline"); 1756 defsymbol (&Qmodeline, "modeline");
1746 defsymbol (&Qgui_element, "gui-element"); 1757 defsymbol (&Qgui_element, "gui-element");
1747 defsymbol (&Qleft_margin, "left-margin");
1748 defsymbol (&Qright_margin, "right-margin");
1749 defsymbol (&Qtext_cursor, "text-cursor"); 1758 defsymbol (&Qtext_cursor, "text-cursor");
1750 defsymbol (&Qvertical_divider, "vertical-divider"); 1759 defsymbol (&Qvertical_divider, "vertical-divider");
1751 1760
1752 DEFSUBR (Ffacep); 1761 DEFSUBR (Ffacep);
1753 DEFSUBR (Ffind_face); 1762 DEFSUBR (Ffind_face);
1865 #ifdef HAVE_TTY 1874 #ifdef HAVE_TTY
1866 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); 1875 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1867 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); 1876 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1868 #endif 1877 #endif
1869 #ifdef HAVE_MS_WINDOWS 1878 #ifdef HAVE_MS_WINDOWS
1879 fg_fb = acons (list1 (Qmsprinter), build_string ("black"), fg_fb);
1880 bg_fb = acons (list1 (Qmsprinter), build_string ("white"), bg_fb);
1870 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb); 1881 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1871 bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb); 1882 bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb);
1872 #endif 1883 #endif
1873 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb); 1884 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb);
1874 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb); 1885 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb);
1911 #ifdef HAVE_TTY 1922 #ifdef HAVE_TTY
1912 inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")), 1923 inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")),
1913 inst_list); 1924 inst_list);
1914 #endif /* HAVE_TTY */ 1925 #endif /* HAVE_TTY */
1915 #ifdef HAVE_MS_WINDOWS 1926 #ifdef HAVE_MS_WINDOWS
1927 /* Fixedsys does not exist for printers */
1928 inst_list = Fcons (Fcons (list1 (Qmsprinter),
1929 build_string ("Courier:Regular:10::Western")), inst_list);
1930 inst_list = Fcons (Fcons (list1 (Qmsprinter),
1931 build_string ("Courier New:Regular:10::Western")), inst_list);
1932
1916 inst_list = Fcons (Fcons (list1 (Qmswindows), 1933 inst_list = Fcons (Fcons (list1 (Qmswindows),
1917 build_string ("Fixedsys:Regular:9::Western")), inst_list); 1934 build_string ("Fixedsys:Regular:9::Western")), inst_list);
1918 inst_list = Fcons (Fcons (list1 (Qmswindows), 1935 inst_list = Fcons (Fcons (list1 (Qmswindows),
1919 build_string ("Courier:Regular:10::Western")), inst_list); 1936 build_string ("Courier:Regular:10::Western")), inst_list);
1920 inst_list = Fcons (Fcons (list1 (Qmswindows), 1937 inst_list = Fcons (Fcons (list1 (Qmswindows),
1954 #ifdef HAVE_TTY 1971 #ifdef HAVE_TTY
1955 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); 1972 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1956 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); 1973 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1957 #endif 1974 #endif
1958 #ifdef HAVE_MS_WINDOWS 1975 #ifdef HAVE_MS_WINDOWS
1976 fg_fb = acons (list1 (Qmsprinter), build_string ("black"), fg_fb);
1977 bg_fb = acons (list1 (Qmsprinter), build_string ("white"), bg_fb);
1959 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb); 1978 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1960 bg_fb = acons (list1 (Qmswindows), build_string ("Gray75"), bg_fb); 1979 bg_fb = acons (list1 (Qmswindows), build_string ("Gray75"), bg_fb);
1961 #endif 1980 #endif
1962 set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb); 1981 set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb);
1963 set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb); 1982 set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb);