Mercurial > hg > xemacs-beta
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 { |