Mercurial > hg > xemacs-beta
annotate src/extents-impl.h @ 5624:c39052c921b5
New "foreback" face property.
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2011-12-27 Didier Verna <didier@xemacs.org>
* cl-macs.el (face-foreback): New defsetf.
* faces.el (set-face-property): Document the foreback property.
* faces.el (face-foreback):
* faces.el (face-foreback-instance):
* faces.el (face-foreback-name):
* faces.el (set-face-foreback): New functions.
* faces.el (face-equal):
* faces.el (init-other-random-faces):
* cus-face.el (custom-face-attributes):
* x-faces.el (x-init-face-from-resources): Handle the foreback
property.
src/ChangeLog addition:
2011-12-27 Didier Verna <didier@xemacs.org>
* faces.h (struct Lisp_Face): New 'foreback slot.
* faces.h (struct face_cachel): New 'foreback and
'foreback_specified slots.
* faces.h (WINDOW_FACE_CACHEL_FOREBACK):
* faces.h (FACE_FOREBACK): New macros.
* faces.c: Declare Qforeback.
* lisp.h: Externalize it.
* faces.c (syms_of_faces): Define it.
* faces.c (vars_of_faces): Update built-in face specifiers.
* faces.c (complex_vars_of_faces): Update specifier fallbacks.
* faces.c (mark_face):
* faces.c (face_equal):
* faces.c (face_getprop):
* faces.c (face_putprop):
* faces.c (face_remprop):
* faces.c (face_plist):
* faces.c (reset_face):
* faces.c (update_face_inheritance_mapper):
* faces.c (Fmake_face):
* faces.c (mark_face_cachels):
* faces.c (update_face_cachel_data):
* faces.c (merge_face_cachel_data):
* faces.c (reset_face_cachel):
* faces.c (face_property_was_changed):
* faces.c (Fcopy_face):
* fontcolor.c (face_color_validate): Handle the foreback property.
* redisplay-msw.c (mswindows_output_blank):
* redisplay-msw.c (mswindows_output_string):
* redisplay-output.c (redisplay_clear_region):
* redisplay-xlike-inc.c (XLIKE_output_string):
* redisplay-xlike-inc.c (XLIKE_output_blank): Use the face's
foreback color instead of the foreground one for drawing a
background bitmap.
| author | Didier Verna <didier@xemacs.org> |
|---|---|
| date | Tue, 27 Dec 2011 17:07:23 +0100 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 872 | 1 /* Copyright (c) 1994, 1995 Free Software Foundation. |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
2 Copyright (c) 1995, 1996, 2002, 2010 Ben Wing. |
| 872 | 3 |
| 4 This file is part of XEmacs. | |
| 5 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5127
diff
changeset
|
6 XEmacs is free software: you can redistribute it and/or modify it |
| 872 | 7 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5127
diff
changeset
|
8 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5127
diff
changeset
|
9 option) any later version. |
| 872 | 10 |
| 11 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 14 for more details. | |
| 15 | |
| 16 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5127
diff
changeset
|
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 872 | 18 |
| 19 /* Synched up with: Not in FSF. */ | |
| 20 | |
| 21 #ifndef INCLUDED_extents_impl_h_ | |
| 22 #define INCLUDED_extents_impl_h_ | |
| 23 | |
| 24 #include "extents.h" | |
| 25 | |
| 26 struct extent | |
| 27 { | |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
28 FROB_BLOCK_LISP_OBJECT_HEADER lheader; |
| 872 | 29 |
| 30 Memxpos start; | |
| 31 Memxpos end; | |
| 32 Lisp_Object object; /* A buffer, string, Qnil (extent detached from no | |
| 33 buffer), Qt (destroyed extent) */ | |
| 34 | |
| 35 /* Extent properties are conceptually a plist, but the most common | |
| 36 props are implemented as bits instead of conses. */ | |
| 37 struct | |
| 38 { | |
| 39 Lisp_Object face; | |
| 40 | |
| 41 /* These flags are simply an optimization for common boolean properties | |
| 42 which go onto the extent's property list. Any of them would work if | |
| 43 done in the normal way, but the space savings of doing these in this | |
| 44 way is significant. Note that if you add a flag, there are numerous | |
| 45 places in extents.c that need to know about it. | |
| 46 | |
| 47 Another consideration is that some of these properties are accessed | |
| 48 during redisplay, so it's good for access to them to be fast (a bit | |
| 49 reference instead of a search down a plist). | |
| 50 | |
| 51 `begin_glyph_layout' and `end_glyph_layout' are unusual in that | |
| 52 they have 4 states instead of 2. | |
| 53 | |
| 54 Other special extent properties are stored in an auxiliary | |
| 55 structure that sits at the beginning of the plist. The has_aux | |
| 56 flag indicates whether this structure exists. The has_parent | |
| 57 flag is an optimization indicating whether the extent has a parent | |
| 58 (this could also be determined by looking in the aux structure). */ | |
| 59 | |
| 60 enum_field (glyph_layout) begin_glyph_layout :2; | |
| 61 /* 2 text, margins, or whitespace */ | |
| 62 enum_field (glyph_layout) end_glyph_layout :2; | |
| 63 /* 4 text, margins, or whitespace */ | |
| 64 unsigned int has_parent :1; /* 5 extent has a parent */ | |
| 65 unsigned int has_aux :1; /* 6 extent has an aux. structure */ | |
| 66 unsigned int start_open :1; /* 7 insertion behavior at start */ | |
| 67 unsigned int end_open :1; /* 8 insertion behavior at end */ | |
| 68 unsigned int unique :1; /* 9 there may be only one attached */ | |
| 69 unsigned int duplicable :1; /* 10 copied to strings by kill/undo */ | |
| 70 unsigned int detachable :1; /* 11 extent detaches if text deleted */ | |
| 71 unsigned int internal :1; /* 12 used by map-extents etc. */ | |
| 72 unsigned int in_red_event :1; /* 13 An event has been spawned for | |
| 73 initial redisplay. | |
| 74 (not exported to lisp) */ | |
| 75 unsigned int unused16 :1; /* 16 unused bits */ | |
| 76 /* --- Adding more flags will cause the extent struct to grow by another | |
| 77 word. It's not clear that this would make a difference, however, | |
| 78 because on 32-bit machines things tend to get allocated in chunks | |
| 79 of 4 bytes. */ | |
| 80 } flags; | |
| 81 /* The plist may have an auxiliary structure as its first element */ | |
| 82 Lisp_Object plist; | |
| 83 }; | |
| 84 | |
| 85 /* Basic properties of an extent (not affected by the extent's parent) */ | |
| 86 #define extent_object(e) ((e)->object) | |
| 87 #define extent_start(e) ((e)->start + 0) | |
| 88 #define extent_end(e) ((e)->end + 0) | |
| 89 #define set_extent_start(e, val) ((void) ((e)->start = (val))) | |
| 90 #define set_extent_end(e, val) ((void) ((e)->end = (val))) | |
| 91 #define extent_endpoint(e, endp) ((endp) ? extent_end (e) : extent_start (e)) | |
| 92 #define set_extent_endpoint(e, val, endp) \ | |
| 93 ((endp) ? set_extent_end (e, val) : set_extent_start (e, val)) | |
| 94 #define extent_detached_p(e) (extent_start (e) < 0) | |
| 95 | |
| 96 /* Additional information that may be present in an extent. The idea is | |
| 97 that fast access is provided to this information, but since (hopefully) | |
| 98 most extents won't have this set on them, we usually don't need to | |
| 99 have this structure around and thus the size of an extent is smaller. */ | |
| 100 | |
| 101 typedef struct extent_auxiliary extent_auxiliary; | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
102 |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
103 #define EXTENT_AUXILIARY_SLOTS \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
104 SLOT (begin_glyph) \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
105 SLOT (end_glyph) \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
106 SLOT (parent) \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
107 /* We use a weak list here. Originally I didn't do this and \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
108 depended on having the extent's finalization method remove \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
109 itself from its parent's children list. This runs into \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
110 lots and lots of problems though because everything is in \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
111 a really really bizarre state when an extent's finalization \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
112 method is called (it happens in sweep_extents() by way of \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
113 ADDITIONAL_FREE_extent()) and it's extremely difficult to \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
114 avoid getting hosed by just-freed objects. */ \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
115 SLOT (children) \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
116 SLOT (invisible) \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
117 SLOT (read_only) \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
118 SLOT (mouse_face) \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
119 SLOT (initial_redisplay_function) \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
120 SLOT (before_change_functions) \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
121 SLOT (after_change_functions) |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
122 |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
123 |
| 872 | 124 struct extent_auxiliary |
| 125 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
126 NORMAL_LISP_OBJECT_HEADER header; |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
127 #define SLOT(x) Lisp_Object x; |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
128 EXTENT_AUXILIARY_SLOTS |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
129 #undef SLOT |
| 872 | 130 int priority; |
| 131 }; | |
| 132 | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
133 extern Lisp_Object Vextent_auxiliary_defaults; |
| 872 | 134 |
| 135 struct extent_info | |
| 136 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
137 NORMAL_LISP_OBJECT_HEADER header; |
| 872 | 138 |
| 139 struct extent_list *extents; | |
| 140 struct stack_of_extents *soe; | |
| 141 }; | |
| 142 | |
| 143 /* A "normal" field is one that is stored in the `struct flags' structure | |
| 144 in an extent. an "aux" field is one that is stored in the extent's | |
| 145 auxiliary structure. | |
| 146 | |
| 147 The functions below that have `extent_no_chase' in their name operate | |
| 148 on an extent directly (ignoring its parent), and should normally | |
| 149 only be used on extents known not to have a parent. The other | |
| 150 versions chase down any parent links. */ | |
| 151 | |
| 152 #define extent_no_chase_normal_field(e, field) ((e)->flags.field) | |
| 153 | |
| 154 DECLARE_INLINE_HEADER ( | |
| 155 struct extent_auxiliary * | |
| 156 extent_aux_or_default (EXTENT e) | |
| 157 ) | |
| 158 { | |
| 159 return e->flags.has_aux ? | |
| 160 XEXTENT_AUXILIARY (XCAR (e->plist)) : | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
161 XEXTENT_AUXILIARY (Vextent_auxiliary_defaults); |
| 872 | 162 } |
| 163 | |
| 164 #define extent_no_chase_aux_field(e, field) (extent_aux_or_default(e)->field) | |
| 165 | |
| 166 #define extent_normal_field(e, field) \ | |
| 167 extent_no_chase_normal_field (extent_ancestor (e), field) | |
| 168 | |
| 169 #define extent_aux_field(e, field) \ | |
| 170 extent_no_chase_aux_field (extent_ancestor (e), field) | |
| 171 | |
| 172 #define set_extent_no_chase_aux_field(e, field, value) do { \ | |
| 173 EXTENT sencaf_e = (e); \ | |
| 174 if (! sencaf_e->flags.has_aux) \ | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
175 attach_extent_auxiliary (sencaf_e); \ |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
176 XEXTENT_AUXILIARY (XCAR (sencaf_e->plist))->field = (value); \ |
| 872 | 177 } while (0) |
| 178 | |
| 179 #define set_extent_no_chase_normal_field(e, field, value) \ | |
| 180 extent_no_chase_normal_field (e, field) = (value) | |
| 181 | |
| 182 #define set_extent_aux_field(e, field, value) \ | |
| 183 set_extent_no_chase_aux_field (extent_ancestor (e), field, value) | |
| 184 | |
| 185 #define set_extent_normal_field(e, field, value) \ | |
| 186 set_extent_no_chase_normal_field (extent_ancestor (e), field, value) | |
| 187 | |
| 188 /* The `parent' and `children' fields are not affected by any | |
| 189 parent links. We don't provide any settors for these fields | |
| 190 because they need special handling and it's cleaner just to | |
| 191 do this in the particular functions that need to do this. */ | |
| 192 | |
| 193 #define extent_parent(e) extent_no_chase_aux_field (e, parent) | |
| 194 #define extent_children(e) extent_no_chase_aux_field (e, children) | |
| 195 | |
| 196 EXTENT extent_ancestor_1 (EXTENT e); | |
| 197 | |
| 198 /* extent_ancestor() chases all the parent links until there aren't any | |
| 199 more. extent_ancestor_1() does the same thing but it a function; | |
| 200 the following optimizes the most common case. */ | |
| 201 DECLARE_INLINE_HEADER ( | |
| 202 EXTENT | |
| 203 extent_ancestor (EXTENT e) | |
| 204 ) | |
| 205 { | |
| 206 return e->flags.has_parent ? extent_ancestor_1 (e) : e; | |
| 207 } | |
| 208 | |
| 209 #define extent_begin_glyph(e) extent_aux_field (e, begin_glyph) | |
| 210 #define extent_end_glyph(e) extent_aux_field (e, end_glyph) | |
| 211 #define extent_priority(e) extent_aux_field (e, priority) | |
| 212 #define extent_invisible(e) extent_aux_field (e, invisible) | |
| 213 #define extent_read_only(e) extent_aux_field (e, read_only) | |
| 214 #define extent_mouse_face(e) extent_aux_field (e, mouse_face) | |
| 215 #define extent_initial_redisplay_function(e) extent_aux_field (e, initial_redisplay_function) | |
| 216 #define extent_before_change_functions(e) extent_aux_field (e, before_change_functions) | |
| 217 #define extent_after_change_functions(e) extent_aux_field (e, after_change_functions) | |
| 218 | |
| 219 #define set_extent_begin_glyph(e, value) \ | |
| 220 set_extent_aux_field (e, begin_glyph, value) | |
| 221 #define set_extent_end_glyph(e, value) \ | |
| 222 set_extent_aux_field (e, end_glyph, value) | |
| 223 #define set_extent_priority(e, value) \ | |
| 224 set_extent_aux_field (e, priority, value) | |
| 225 #define set_extent_invisible_1(e, value) \ | |
| 226 set_extent_aux_field (e, invisible, value) | |
| 227 #define set_extent_read_only(e, value) \ | |
| 228 set_extent_aux_field (e, read_only, value) | |
| 229 #define set_extent_mouse_face(e, value) \ | |
| 230 set_extent_aux_field (e, mouse_face, value) | |
| 231 /* Use Fset_extent_initial_redisplay_function unless you know what you're doing */ | |
| 232 #define set_extent_initial_redisplay_function(e, value) \ | |
| 233 set_extent_aux_field (e, initial_redisplay_function, value) | |
| 234 #define set_extent_before_change_functions(e, value) \ | |
| 235 set_extent_aux_field (e, before_change_functions, value) | |
| 236 #define set_extent_after_change_functions(e, value) \ | |
| 237 set_extent_aux_field (e, after_change_functions, value) | |
| 238 | |
| 239 #define extent_face(e) extent_normal_field (e, face) | |
| 240 #define extent_begin_glyph_layout(e) ((enum glyph_layout) extent_normal_field (e, begin_glyph_layout)) | |
| 241 #define extent_end_glyph_layout(e) ((enum glyph_layout) extent_normal_field (e, end_glyph_layout)) | |
| 242 #define extent_start_open_p(e) extent_normal_field (e, start_open) | |
| 243 #define extent_end_open_p(e) extent_normal_field (e, end_open) | |
| 244 #define extent_unique_p(e) extent_normal_field (e, unique) | |
| 245 #define extent_duplicable_p(e) extent_normal_field (e, duplicable) | |
| 246 #define extent_detachable_p(e) extent_normal_field (e, detachable) | |
| 247 #define extent_internal_p(e) extent_normal_field (e, internal) | |
| 248 #define extent_in_red_event_p(e) extent_normal_field (e, in_red_event) | |
| 249 | |
| 250 #define set_extent_face(e, val) \ | |
| 251 set_extent_normal_field (e, face, val) | |
| 252 #define set_extent_begin_glyph_layout(e, val) \ | |
| 253 set_extent_normal_field (e, begin_glyph_layout, val) | |
| 254 #define set_extent_end_glyph_layout(e, val) \ | |
| 255 set_extent_normal_field (e, end_glyph_layout, val) | |
| 256 #define set_extent_start_open_p(e, val) \ | |
| 257 set_extent_normal_field (e, start_open, val) | |
| 258 #define set_extent_end_open_p(e, val) \ | |
| 259 set_extent_normal_field (e, end_open, val) | |
| 260 #define set_extent_unique_p(e, val) \ | |
| 261 set_extent_normal_field (e, unique, val) | |
| 262 #define set_extent_duplicable_p(e, val) \ | |
| 263 set_extent_normal_field (e, duplicable, val) | |
| 264 #define set_extent_detachable_p(e, val) \ | |
| 265 set_extent_normal_field (e, detachable, val) | |
| 266 #define set_extent_internal_p(e, val) \ | |
| 267 set_extent_normal_field (e, internal, val) | |
| 268 #define set_extent_in_red_event_p(e, val) \ | |
| 269 set_extent_normal_field (e, in_red_event, val) | |
| 270 | |
| 271 DECLARE_INLINE_HEADER ( | |
| 272 Lisp_Object * | |
| 273 extent_no_chase_plist_addr (EXTENT e) | |
| 274 ) | |
| 275 { | |
| 276 return e->flags.has_aux ? &XCDR (e->plist) : &e->plist; | |
| 277 } | |
| 278 | |
| 279 #define extent_no_chase_plist(e) (*extent_no_chase_plist_addr (e)) | |
| 280 | |
| 281 #define extent_plist_addr(e) extent_no_chase_plist_addr (extent_ancestor (e)) | |
| 282 #define extent_plist_slot(e) extent_no_chase_plist (extent_ancestor (e)) | |
| 283 | |
| 284 | |
| 285 #define EXTENT_LIVE_P(e) (!EQ (extent_object (e), Qt)) | |
| 286 | |
| 287 #define CHECK_LIVE_EXTENT(x) do { \ | |
| 288 CHECK_EXTENT (x); \ | |
| 289 if (!EXTENT_LIVE_P (XEXTENT (x))) \ | |
| 290 dead_wrong_type_argument (Qextent_live_p, (x)); \ | |
| 291 } while (0) | |
| 292 #define CONCHECK_LIVE_EXTENT(x) do { \ | |
| 293 CONCHECK_EXTENT (x); \ | |
| 294 if (!EXTENT_LIVE_P (XEXTENT (x))) \ | |
| 295 x = wrong_type_argument (Qextent_live_p, (x)); \ | |
| 296 } while (0) | |
| 297 | |
| 298 #endif /* INCLUDED_extents_impl_h_ */ |