comparison src/faces.c @ 272:c5d627a313b1 r21-0b34

Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents b2472a1930f2
children c42ec1d1cded
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
39 #include "hash.h" 39 #include "hash.h"
40 #include "objects.h" 40 #include "objects.h"
41 #include "specifier.h" 41 #include "specifier.h"
42 #include "window.h" 42 #include "window.h"
43 43
44 /* Qfont, Qdoc_string, Qface defined in general.c */
45 Lisp_Object Qfacep; 44 Lisp_Object Qfacep;
46 Lisp_Object Qforeground, Qbackground, Qdisplay_table; 45 Lisp_Object Qforeground, Qbackground, Qdisplay_table;
47 /* Qhighlight, Qreverse defined in general.c */
48 Lisp_Object Qbackground_pixmap, Qunderline, Qdim; 46 Lisp_Object Qbackground_pixmap, Qunderline, Qdim;
49 Lisp_Object Qblinking, Qstrikethru; 47 Lisp_Object Qblinking, Qstrikethru;
50 48
51 Lisp_Object Qinit_face_from_resources; 49 Lisp_Object Qinit_face_from_resources;
52 Lisp_Object Qinit_frame_faces; 50 Lisp_Object Qinit_frame_faces;
71 Lisp_Object Vtemporary_faces_cache; 69 Lisp_Object Vtemporary_faces_cache;
72 70
73 Lisp_Object Vbuilt_in_face_specifiers; 71 Lisp_Object Vbuilt_in_face_specifiers;
74 72
75 73
76 static Lisp_Object mark_face (Lisp_Object, void (*) (Lisp_Object));
77 static void print_face (Lisp_Object, Lisp_Object, int);
78 static int face_equal (Lisp_Object, Lisp_Object, int depth);
79 static unsigned long face_hash (Lisp_Object obj, int depth);
80 static Lisp_Object face_getprop (Lisp_Object obj, Lisp_Object prop);
81 static int face_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value);
82 static int face_remprop (Lisp_Object obj, Lisp_Object prop);
83 static Lisp_Object face_plist (Lisp_Object obj);
84 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face,
85 mark_face, print_face, 0, face_equal,
86 face_hash, face_getprop,
87 face_putprop, face_remprop,
88 face_plist, struct Lisp_Face);
89 74
90 static Lisp_Object 75 static Lisp_Object
91 mark_face (Lisp_Object obj, void (*markobj) (Lisp_Object)) 76 mark_face (Lisp_Object obj, void (*markobj) (Lisp_Object))
92 { 77 {
93 struct Lisp_Face *face = XFACE (obj); 78 struct Lisp_Face *face = XFACE (obj);
259 } 244 }
260 245
261 static Lisp_Object 246 static Lisp_Object
262 face_plist (Lisp_Object obj) 247 face_plist (Lisp_Object obj)
263 { 248 {
264 struct Lisp_Face *f = XFACE (obj); 249 struct Lisp_Face *face = XFACE (obj);
265 Lisp_Object result = Qnil; 250 Lisp_Object result = face->plist;
266 251
267 /* backwards order; we reverse it below */ 252 result = cons3 (Qreverse, face->reverse, result);
268 result = Fcons (f->foreground, Fcons (Qforeground, result)); 253 result = cons3 (Qblinking, face->blinking, result);
269 result = Fcons (f->background, Fcons (Qbackground, result)); 254 result = cons3 (Qdim, face->dim, result);
270 result = Fcons (f->font, Fcons (Qfont, result)); 255 result = cons3 (Qhighlight, face->highlight, result);
271 result = Fcons (f->display_table, Fcons (Qdisplay_table, result)); 256 result = cons3 (Qstrikethru, face->strikethru, result);
272 result = Fcons (f->background_pixmap, Fcons (Qbackground_pixmap, result)); 257 result = cons3 (Qunderline, face->underline, result);
273 result = Fcons (f->underline, Fcons (Qunderline, result)); 258 result = cons3 (Qbackground_pixmap, face->background_pixmap, result);
274 result = Fcons (f->strikethru, Fcons (Qstrikethru, result)); 259 result = cons3 (Qdisplay_table, face->display_table, result);
275 result = Fcons (f->highlight, Fcons (Qhighlight, result)); 260 result = cons3 (Qfont, face->font, result);
276 result = Fcons (f->dim, Fcons (Qdim, result)); 261 result = cons3 (Qbackground, face->background, result);
277 result = Fcons (f->blinking, Fcons (Qblinking, result)); 262 result = cons3 (Qforeground, face->foreground, result);
278 result = Fcons (f->reverse, Fcons (Qreverse, result)); 263
279 264 return result;
280 return nconc2 (Fnreverse (result), f->plist); 265 }
281 } 266
282 267 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face,
268 mark_face, print_face, 0, face_equal,
269 face_hash, face_getprop,
270 face_putprop, face_remprop,
271 face_plist, struct Lisp_Face);
283 272
284 /************************************************************************/ 273 /************************************************************************/
285 /* face read syntax */ 274 /* face read syntax */
286 /************************************************************************/ 275 /************************************************************************/
287 276
433 mark_face_as_clean_mapper (CONST void *hash_key, void *hash_contents, 422 mark_face_as_clean_mapper (CONST void *hash_key, void *hash_contents,
434 void *flag_closure) 423 void *flag_closure)
435 { 424 {
436 /* This function can GC */ 425 /* This function can GC */
437 Lisp_Object key, contents; 426 Lisp_Object key, contents;
438 int *flag = flag_closure; 427 int *flag = (int *) flag_closure;
439 CVOID_TO_LISP (key, hash_key); 428 CVOID_TO_LISP (key, hash_key);
440 VOID_TO_LISP (contents, hash_contents); 429 VOID_TO_LISP (contents, hash_contents);
441 XFACE (contents)->dirty = *flag; 430 XFACE (contents)->dirty = *flag;
442 return 0; 431 return 0;
443 } 432 }
762 751
763 return face_list; 752 return face_list;
764 } 753 }
765 754
766 DEFUN ("make-face", Fmake_face, 1, 3, 0, /* 755 DEFUN ("make-face", Fmake_face, 1, 3, 0, /*
767 Defines and returns a new FACE described by DOC-STRING. 756 Define and return a new FACE described by DOC-STRING.
768 You can modify the font, color, etc of a face with the set-face- functions. 757 You can modify the font, color, etc of a face with the set-face-* functions.
769 If the face already exists, it is unmodified. 758 If the face already exists, it is unmodified.
770 If TEMPORARY is non-nil, this face will cease to exist if not in use. 759 If TEMPORARY is non-nil, this face will cease to exist if not in use.
771 */ 760 */
772 (name, doc_string, temporary)) 761 (name, doc_string, temporary))
773 { 762 {
1222 #define FROB(field) \ 1211 #define FROB(field) \
1223 do { \ 1212 do { \
1224 Lisp_Object new_val = \ 1213 Lisp_Object new_val = \
1225 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \ 1214 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
1226 int bound = 1; \ 1215 int bound = 1; \
1227 int new_val_int; \ 1216 unsigned int new_val_int; \
1228 if (UNBOUNDP (new_val)) \ 1217 if (UNBOUNDP (new_val)) \
1229 { \ 1218 { \
1230 bound = 0; \ 1219 bound = 0; \
1231 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \ 1220 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1232 } \ 1221 } \
1302 /* Initialize a cachel. */ 1291 /* Initialize a cachel. */
1303 1292
1304 void 1293 void
1305 reset_face_cachel (struct face_cachel *cachel) 1294 reset_face_cachel (struct face_cachel *cachel)
1306 { 1295 {
1307 memset (cachel, 0, sizeof (struct face_cachel)); 1296 xzero (*cachel);
1308 cachel->face = Qunbound; 1297 cachel->face = Qunbound;
1309 cachel->nfaces = 0; 1298 cachel->nfaces = 0;
1310 cachel->merged_faces = 0; 1299 cachel->merged_faces = 0;
1311 cachel->foreground = Qunbound; 1300 cachel->foreground = Qunbound;
1312 cachel->background = Qunbound; 1301 cachel->background = Qunbound;
1350 { 1339 {
1351 struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt); 1340 struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt);
1352 1341
1353 if (EQ (cachel->face, face)) 1342 if (EQ (cachel->face, face))
1354 { 1343 {
1355 Lisp_Object window = Qnil; 1344 Lisp_Object window;
1356 XSETWINDOW (window, w); 1345 XSETWINDOW (window, w);
1357 if (!cachel->updated) 1346 if (!cachel->updated)
1358 update_face_cachel_data (cachel, window, face); 1347 update_face_cachel_data (cachel, window, face);
1359 return elt; 1348 return elt;
1360 } 1349 }
1507 struct extent_fragment *ef) 1496 struct extent_fragment *ef)
1508 { 1497 {
1509 struct face_cachel cachel; 1498 struct face_cachel cachel;
1510 int len = Dynarr_length (ef->extents); 1499 int len = Dynarr_length (ef->extents);
1511 face_index findex = 0; 1500 face_index findex = 0;
1512 Lisp_Object window = Qnil; 1501 Lisp_Object window;
1513 XSETWINDOW (window, w); 1502 XSETWINDOW (window, w);
1514 1503
1515 /* Optimize the default case. */ 1504 /* Optimize the default case. */
1516 if (len == 0) 1505 if (len == 0)
1517 return DEFAULT_INDEX; 1506 return DEFAULT_INDEX;
1618 } 1607 }
1619 1608
1620 void 1609 void
1621 update_frame_face_values (struct frame *f) 1610 update_frame_face_values (struct frame *f)
1622 { 1611 {
1623 Lisp_Object frm = Qnil; 1612 Lisp_Object frm;
1624 1613
1625 XSETFRAME (frm, f); 1614 XSETFRAME (frm, f);
1626 update_EmacsFrame (frm, Qforeground); 1615 update_EmacsFrame (frm, Qforeground);
1627 update_EmacsFrame (frm, Qbackground); 1616 update_EmacsFrame (frm, Qbackground);
1628 update_EmacsFrame (frm, Qfont); 1617 update_EmacsFrame (frm, Qfont);
1642 EQ (property, Qfont))) 1631 EQ (property, Qfont)))
1643 update_EmacsFrames (locale, property); 1632 update_EmacsFrames (locale, property);
1644 1633
1645 if (WINDOWP (locale)) 1634 if (WINDOWP (locale))
1646 { 1635 {
1647 MARK_FRAME_FACES_CHANGED (XFRAME (XWINDOW (locale)->frame)); 1636 struct frame *f = XFRAME (XWINDOW (locale)->frame);
1637 MARK_FRAME_FACES_CHANGED (f);
1648 } 1638 }
1649 else if (FRAMEP (locale)) 1639 else if (FRAMEP (locale))
1650 { 1640 {
1651 MARK_FRAME_FACES_CHANGED (XFRAME (locale)); 1641 struct frame *f = XFRAME (locale);
1642 MARK_FRAME_FACES_CHANGED (f);
1652 } 1643 }
1653 else if (DEVICEP (locale)) 1644 else if (DEVICEP (locale))
1654 { 1645 {
1655 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (locale)); 1646 struct device *d = XDEVICE (locale);
1647 MARK_DEVICE_FRAMES_FACES_CHANGED (d);
1656 } 1648 }
1657 else 1649 else
1658 { 1650 {
1659 Lisp_Object devcons, concons; 1651 Lisp_Object devcons, concons;
1660 1652
1682 /* update_faces_inheritance (face, property);*/ 1674 /* update_faces_inheritance (face, property);*/
1683 XFACE (face)->dirty = 1; 1675 XFACE (face)->dirty = 1;
1684 } 1676 }
1685 1677
1686 DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /* 1678 DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /*
1687 Defines and returns a new face which is a copy of an existing one, 1679 Define and return a new face which is a copy of an existing one,
1688 or makes an already-existing face be exactly like another. LOCALE, 1680 or makes an already-existing face be exactly like another.
1689 TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'. 1681 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'.
1690 */ 1682 */
1691 (old_face, new_name, locale, tag_set, exact_p, how_to_add)) 1683 (old_face, new_name, locale, tag_set, exact_p, how_to_add))
1692 { 1684 {
1693 struct Lisp_Face *fold, *fnew; 1685 struct Lisp_Face *fold, *fnew;
1694 Lisp_Object new_face = Qnil; 1686 Lisp_Object new_face = Qnil;
1855 1847
1856 /* Provide some last-resort fallbacks to avoid utter fuckage if 1848 /* Provide some last-resort fallbacks to avoid utter fuckage if
1857 someone provides invalid values for the global specifications. */ 1849 someone provides invalid values for the global specifications. */
1858 1850
1859 { 1851 {
1860 Lisp_Object fg_inst_list = Qnil, bg_inst_list = Qnil; 1852 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1861 1853
1862 #ifdef HAVE_X_WINDOWS 1854 #ifdef HAVE_X_WINDOWS
1863 fg_inst_list = Fcons (Fcons (list1 (Qx), build_string ("black")), 1855 fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
1864 fg_inst_list); 1856 bg_fb = acons (list1 (Qx), build_string ("white"), bg_fb);
1865 bg_inst_list = Fcons (Fcons (list1 (Qx), build_string ("white")),
1866 bg_inst_list);
1867 #endif 1857 #endif
1868 #ifdef HAVE_TTY 1858 #ifdef HAVE_TTY
1869 fg_inst_list = Fcons (Fcons (list1 (Qtty), Fvector (0, 0)), 1859 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1870 fg_inst_list); 1860 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1871 bg_inst_list = Fcons (Fcons (list1 (Qtty), Fvector (0, 0)),
1872 bg_inst_list);
1873 #endif 1861 #endif
1874 #ifdef HAVE_MS_WINDOWS 1862 #ifdef HAVE_MS_WINDOWS
1875 fg_inst_list = Fcons (Fcons (list1 (Qmswindows), build_string ("black")), 1863 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1876 fg_inst_list); 1864 bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb);
1877 bg_inst_list = Fcons (Fcons (list1 (Qmswindows), build_string ("white")),
1878 bg_inst_list);
1879 #endif 1865 #endif
1880 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), 1866 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb);
1881 fg_inst_list); 1867 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb);
1882 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil),
1883 bg_inst_list);
1884 } 1868 }
1885 1869
1886 /* #### We may want to have different fallback values if NeXTstep 1870 /* #### We may want to have different fallback values if NeXTstep
1887 support is compiled in. */ 1871 support is compiled in. */
1888 { 1872 {