X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fextents.c;h=be980e98133742883f8d494167b8e917a6eb1186;hb=07494efa4c17d879a598113094a00f53dd1b3f07;hp=da6bde74d9b4f32df1a8a50a6ada2e85f261ebfd;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910;p=chise%2Fxemacs-chise.git.1 diff --git a/src/extents.c b/src/extents.c index da6bde7..be980e9 100644 --- a/src/extents.c +++ b/src/extents.c @@ -1,6 +1,6 @@ /* Copyright (c) 1994, 1995 Free Software Foundation, Inc. Copyright (c) 1995 Sun Microsystems, Inc. - Copyright (c) 1995, 1996 Ben Wing. + Copyright (c) 1995, 1996, 2000 Ben Wing. This file is part of XEmacs. @@ -222,12 +222,12 @@ Boston, MA 02111-1307, USA. */ #include "faces.h" #include "frame.h" #include "glyphs.h" -#include "hash.h" #include "insdel.h" #include "keymap.h" #include "opaque.h" #include "process.h" #include "redisplay.h" +#include "gutter.h" /* ------------------------------- */ /* gap array */ @@ -261,7 +261,7 @@ typedef struct gap_array Gap_Array_Marker *markers; } Gap_Array; -Gap_Array_Marker *gap_array_marker_freelist; +static Gap_Array_Marker *gap_array_marker_freelist; /* Convert a "memory position" (i.e. taking the gap into account) into the address of the element at (i.e. after) that position. "Memory @@ -302,7 +302,7 @@ typedef struct extent_list Extent_List_Marker *markers; } Extent_List; -Extent_List_Marker *extent_list_marker_freelist; +static Extent_List_Marker *extent_list_marker_freelist; #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \ ((extent_start (e) == (st)) && \ @@ -406,7 +406,7 @@ typedef int Endpoint_Index; #define DE_MUST_BE_ATTACHED 2 Lisp_Object Vlast_highlighted_extent; -int mouse_highlight_priority; +Fixnum mouse_highlight_priority; Lisp_Object Qextentp; Lisp_Object Qextent_live_p; @@ -445,9 +445,6 @@ Lisp_Object Qinside_margin; Lisp_Object Qwhitespace; /* Qtext defined in general.c */ -/* partially used in redisplay */ -Lisp_Object Qglyph_invisible; - Lisp_Object Qcopy_function; Lisp_Object Qpaste_function; @@ -465,10 +462,13 @@ Lisp_Object Vextent_face_reusable_list; /* FSFmacs bogosity */ Lisp_Object Vdefault_text_properties; - EXFUN (Fextent_properties, 1); EXFUN (Fset_extent_property, 3); +/* if true, we don't want to set any redisplay flags on modeline extent + changes */ +int in_modeline_generation; + /************************************************************************/ /* Generalized gap array */ @@ -536,7 +536,7 @@ gap_array_make_gap (Gap_Array *ga, int increment) int old_gap_size; /* If we have to get more space, get enough to last a while. We use - a geometric progession that saves on realloc space. */ + a geometric progression that saves on realloc space. */ increment += 100 + ga->numels / 8; ptr = (char *) xrealloc (ptr, @@ -891,8 +891,8 @@ static Extent_List * allocate_extent_list (void) { Extent_List *el = xnew (Extent_List); - el->start = make_gap_array (sizeof(EXTENT)); - el->end = make_gap_array (sizeof(EXTENT)); + el->start = make_gap_array (sizeof (EXTENT)); + el->end = make_gap_array (sizeof (EXTENT)); el->markers = 0; return el; } @@ -911,29 +911,31 @@ free_extent_list (Extent_List *el) /************************************************************************/ static Lisp_Object -mark_extent_auxiliary (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_extent_auxiliary (Lisp_Object obj) { struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj); - ((markobj) (data->begin_glyph)); - ((markobj) (data->end_glyph)); - ((markobj) (data->invisible)); - ((markobj) (data->children)); - ((markobj) (data->read_only)); - ((markobj) (data->mouse_face)); - ((markobj) (data->initial_redisplay_function)); + mark_object (data->begin_glyph); + mark_object (data->end_glyph); + mark_object (data->invisible); + mark_object (data->children); + mark_object (data->read_only); + mark_object (data->mouse_face); + mark_object (data->initial_redisplay_function); + mark_object (data->before_change_functions); + mark_object (data->after_change_functions); return data->parent; } DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary, mark_extent_auxiliary, internal_object_printer, - 0, 0, 0, struct extent_auxiliary); + 0, 0, 0, 0, struct extent_auxiliary); void allocate_extent_auxiliary (EXTENT ext) { Lisp_Object extent_aux; struct extent_auxiliary *data = - alloc_lcrecord_type (struct extent_auxiliary, lrecord_extent_auxiliary); + alloc_lcrecord_type (struct extent_auxiliary, &lrecord_extent_auxiliary); copy_lcrecord (data, &extent_auxiliary_defaults); XSETEXTENT_AUXILIARY (extent_aux, data); @@ -972,12 +974,11 @@ static void free_soe (struct stack_of_extents *soe); static void soe_invalidate (Lisp_Object obj); static Lisp_Object -mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_extent_info (Lisp_Object obj) { - struct extent_info *data = - (struct extent_info *) XEXTENT_INFO (obj); + struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj); int i; - Extent_List *list; + Extent_List *list = data->extents; /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like objects that are created specially and never have their extent @@ -988,7 +989,6 @@ mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object)) (Also the list can be zero when we're dealing with a destroyed buffer.) */ - list = data->extents; if (list) { for (i = 0; i < extent_list_num_els (list); i++) @@ -997,7 +997,7 @@ mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object)) Lisp_Object exobj; XSETEXTENT (exobj, extent); - ((markobj) (exobj)); + mark_object (exobj); } } @@ -1026,7 +1026,7 @@ finalize_extent_info (void *header, int for_disksave) DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, mark_extent_info, internal_object_printer, - finalize_extent_info, 0, 0, + finalize_extent_info, 0, 0, 0, struct extent_info); static Lisp_Object @@ -1034,7 +1034,7 @@ allocate_extent_info (void) { Lisp_Object extent_info; struct extent_info *data = - alloc_lcrecord_type (struct extent_info, lrecord_extent_info); + alloc_lcrecord_type (struct extent_info, &lrecord_extent_info); XSETEXTENT_INFO (extent_info, data); data->extents = allocate_extent_list (); @@ -1175,11 +1175,12 @@ detach_all_extents (Lisp_Object object) set_extent_start (e, -1); set_extent_end (e, -1); } + + /* But we need to clear all the lists containing extents or + havoc will result. */ + extent_list_delete_all (data->extents); } - /* But we need to clear all the lists containing extents or - havoc will result. */ - extent_list_delete_all (data->extents); soe_invalidate (object); } } @@ -1541,8 +1542,7 @@ extent_endpoint_bytind (EXTENT extent, int endp) assert (EXTENT_LIVE_P (extent)); assert (!extent_detached_p (extent)); { - Memind i = (endp) ? (extent_end (extent)) : - (extent_start (extent)); + Memind i = endp ? extent_end (extent) : extent_start (extent); Lisp_Object obj = extent_object (extent); return buffer_or_string_memind_to_bytind (obj, i); } @@ -1554,8 +1554,7 @@ extent_endpoint_bufpos (EXTENT extent, int endp) assert (EXTENT_LIVE_P (extent)); assert (!extent_detached_p (extent)); { - Memind i = (endp) ? (extent_end (extent)) : - (extent_start (extent)); + Memind i = endp ? extent_end (extent) : extent_start (extent); Lisp_Object obj = extent_object (extent); return buffer_or_string_memind_to_bufpos (obj, i); } @@ -1595,33 +1594,47 @@ extent_changed_for_redisplay (EXTENT extent, int descendants_too, object = extent_object (extent); - if (!BUFFERP (object) || extent_detached_p (extent)) - /* #### Can changes to string extents affect redisplay? - I will have to think about this. What about string glyphs? - Things in the modeline? etc. */ - /* #### changes to string extents can certainly affect redisplay - if the extent is in some generated-modeline-string: when - we change an extent in generated-modeline-string, this changes - its parent, which is in `modeline-format', so we should - force the modeline to be updated. But how to determine whether - a string is a `generated-modeline-string'? Looping through - all buffers is not very efficient. Should we add all - `generated-modeline-string' strings to a hashtable? - Maybe efficiency is not the greatest concern here and there's - no big loss in looping over the buffers. */ + if (extent_detached_p (extent)) return; - { - struct buffer *b; - b = XBUFFER (object); - BUF_FACECHANGE (b)++; - MARK_EXTENTS_CHANGED; - if (invisibility_change) - MARK_CLIP_CHANGED; - buffer_extent_signal_changed_region (b, - extent_endpoint_bufpos (extent, 0), - extent_endpoint_bufpos (extent, 1)); - } + else if (STRINGP (object)) + { + /* #### Changes to string extents can affect redisplay if they are + in the modeline or in the gutters. + + If the extent is in some generated-modeline-string: when we + change an extent in generated-modeline-string, this changes its + parent, which is in `modeline-format', so we should force the + modeline to be updated. But how to determine whether a string + is a `generated-modeline-string'? Looping through all buffers + is not very efficient. Should we add all + `generated-modeline-string' strings to a hash table? Maybe + efficiency is not the greatest concern here and there's no big + loss in looping over the buffers. + + If the extent is in a gutter we mark the gutter as + changed. This means (a) we can update extents in the gutters + when we need it. (b) we don't have to update the gutters when + only extents attached to buffers have changed. */ + + if (!in_modeline_generation) + MARK_EXTENTS_CHANGED; + gutter_extent_signal_changed_region_maybe (object, + extent_endpoint_bufpos (extent, 0), + extent_endpoint_bufpos (extent, 1)); + } + else if (BUFFERP (object)) + { + struct buffer *b; + b = XBUFFER (object); + BUF_FACECHANGE (b)++; + MARK_EXTENTS_CHANGED; + if (invisibility_change) + MARK_CLIP_CHANGED; + buffer_extent_signal_changed_region (b, + extent_endpoint_bufpos (extent, 0), + extent_endpoint_bufpos (extent, 1)); + } } /* A change to an extent occurred that might affect redisplay. @@ -1822,7 +1835,7 @@ extent_in_region_p (EXTENT extent, Bytind from, Bytind to, Endpoint_Index start, end, exs, exe; int start_open, end_open; unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK; - unsigned int in_region_flags = flags & ME_IN_REGION_MASK; + unsigned int in_region_flags = flags & ME_IN_REGION_MASK; int retval; /* A zero-length region is treated as closed-closed. */ @@ -1832,31 +1845,30 @@ extent_in_region_p (EXTENT extent, Bytind from, Bytind to, flags &= ~ME_START_OPEN; } - switch (all_extents_flags) + /* So is a zero-length extent. */ + if (extent_start (extent) == extent_end (extent)) + start_open = 0, end_open = 0; + /* `all_extents_flags' will almost always be zero. */ + else if (all_extents_flags == 0) { - case ME_ALL_EXTENTS_CLOSED: - start_open = end_open = 0; break; - case ME_ALL_EXTENTS_OPEN: - start_open = end_open = 1; break; - case ME_ALL_EXTENTS_CLOSED_OPEN: - start_open = 0; end_open = 1; break; - case ME_ALL_EXTENTS_OPEN_CLOSED: - start_open = 1; end_open = 0; break; - default: start_open = extent_start_open_p (extent); - end_open = extent_end_open_p (extent); - break; + end_open = extent_end_open_p (extent); } - - /* So is a zero-length extent. */ - if (extent_start (extent) == extent_end (extent)) - start_open = end_open = 0; + else + switch (all_extents_flags) + { + case ME_ALL_EXTENTS_CLOSED: start_open = 0, end_open = 0; break; + case ME_ALL_EXTENTS_OPEN: start_open = 1, end_open = 1; break; + case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break; + case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break; + default: ABORT(); return 0; + } start = buffer_or_string_bytind_to_startind (obj, from, flags & ME_START_OPEN); end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED)); exs = memind_to_startind (extent_start (extent), start_open); - exe = memind_to_endind (extent_end (extent), end_open); + exe = memind_to_endind (extent_end (extent), end_open); /* It's easy to determine whether an extent lies *outside* the region -- just determine whether it's completely before @@ -1868,20 +1880,24 @@ extent_in_region_p (EXTENT extent, Bytind from, Bytind to, return 0; /* See if any further restrictions are called for. */ - switch (in_region_flags) - { - case ME_START_IN_REGION: - retval = start <= exs && exs <= end; break; - case ME_END_IN_REGION: - retval = start <= exe && exe <= end; break; - case ME_START_AND_END_IN_REGION: - retval = start <= exs && exe <= end; break; - case ME_START_OR_END_IN_REGION: - retval = (start <= exs && exs <= end) || (start <= exe && exe <= end); - break; - default: - retval = 1; break; - } + /* in_region_flags will almost always be zero. */ + if (in_region_flags == 0) + retval = 1; + else + switch (in_region_flags) + { + case ME_START_IN_REGION: + retval = start <= exs && exs <= end; break; + case ME_END_IN_REGION: + retval = start <= exe && exe <= end; break; + case ME_START_AND_END_IN_REGION: + retval = start <= exs && exe <= end; break; + case ME_START_OR_END_IN_REGION: + retval = (start <= exs && exs <= end) || (start <= exe && exe <= end); + break; + default: + ABORT(); return 0; + } return flags & ME_NEGATE_IN_REGION ? !retval : retval; } @@ -2600,12 +2616,11 @@ extent_fragment_delete (struct extent_fragment *ef) xfree (ef); } -/* Note: CONST is losing, but `const' is part of the interface of qsort() */ static int extent_priority_sort_function (const void *humpty, const void *dumpty) { - CONST EXTENT foo = * (CONST EXTENT *) humpty; - CONST EXTENT bar = * (CONST EXTENT *) dumpty; + const EXTENT foo = * (const EXTENT *) humpty; + const EXTENT bar = * (const EXTENT *) dumpty; if (extent_priority (foo) < extent_priority (bar)) return -1; return extent_priority (foo) > extent_priority (bar); @@ -2739,9 +2754,10 @@ invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list) face_index extent_fragment_update (struct window *w, struct extent_fragment *ef, - Bytind pos) + Bytind pos, Lisp_Object last_glyph) { int i; + int seen_glyph = NILP (last_glyph) ? 1 : 0; Extent_List *sel = buffer_or_string_stack_of_extents_force (ef->object)->extents; EXTENT lhe = 0; @@ -2782,11 +2798,15 @@ extent_fragment_update (struct window *w, struct extent_fragment *ef, if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e))) { Lisp_Object glyph = extent_begin_glyph (e); - struct glyph_block gb; - - gb.glyph = glyph; - XSETEXTENT (gb.extent, e); - Dynarr_add (ef->begin_glyphs, gb); + if (seen_glyph) { + struct glyph_block gb; + + gb.glyph = glyph; + XSETEXTENT (gb.extent, e); + Dynarr_add (ef->begin_glyphs, gb); + } + else if (EQ (glyph, last_glyph)) + seen_glyph = 1; } } @@ -2797,11 +2817,15 @@ extent_fragment_update (struct window *w, struct extent_fragment *ef, if (extent_end (e) == mempos && !NILP (extent_end_glyph (e))) { Lisp_Object glyph = extent_end_glyph (e); - struct glyph_block gb; + if (seen_glyph) { + struct glyph_block gb; - gb.glyph = glyph; - XSETEXTENT (gb.extent, e); - Dynarr_add (ef->end_glyphs, gb); + gb.glyph = glyph; + XSETEXTENT (gb.extent, e); + Dynarr_add (ef->end_glyphs, gb); + } + else if (EQ (glyph, last_glyph)) + seen_glyph = 1; } } @@ -2864,7 +2888,7 @@ extent_fragment_update (struct window *w, struct extent_fragment *ef, xzero (dummy_lhe_extent); set_extent_priority (&dummy_lhe_extent, mouse_highlight_priority); - /* Need to break up thefollowing expression, due to an */ + /* Need to break up the following expression, due to an */ /* error in the Digital UNIX 3.2g C compiler (Digital */ /* UNIX Compiler Driver 3.11). */ f = extent_mouse_face (lhe); @@ -2911,37 +2935,13 @@ extent_fragment_update (struct window *w, struct extent_fragment *ef, extent objects. They are similar to the functions for other lrecord objects. allocate_extent() is in alloc.c, not here. */ -static Lisp_Object mark_extent (Lisp_Object, void (*) (Lisp_Object)); -static int extent_equal (Lisp_Object, Lisp_Object, int depth); -static unsigned long extent_hash (Lisp_Object obj, int depth); -static void print_extent (Lisp_Object obj, Lisp_Object printcharfun, - int escapeflag); -static Lisp_Object extent_getprop (Lisp_Object obj, Lisp_Object prop); -static int extent_putprop (Lisp_Object obj, Lisp_Object prop, - Lisp_Object value); -static int extent_remprop (Lisp_Object obj, Lisp_Object prop); -static Lisp_Object extent_plist (Lisp_Object obj); - -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent, - mark_extent, - print_extent, - /* NOTE: If you declare a - finalization method here, - it will NOT be called. - Shaft city. */ - 0, - extent_equal, extent_hash, - extent_getprop, extent_putprop, - extent_remprop, extent_plist, - struct extent); - static Lisp_Object -mark_extent (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_extent (Lisp_Object obj) { struct extent *extent = XEXTENT (obj); - ((markobj) (extent_object (extent))); - ((markobj) (extent_no_chase_normal_field (extent, face))); + mark_object (extent_object (extent)); + mark_object (extent_no_chase_normal_field (extent, face)); return extent->plist; } @@ -2960,11 +2960,9 @@ print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) if (extent_detached_p (ext)) strcpy (bp, "detached"); else - { - Bufpos from = XINT (Fextent_start_position (obj)); - Bufpos to = XINT (Fextent_end_position (obj)); - sprintf (bp, "%d, %d", from, to); - } + sprintf (bp, "%ld, %ld", + XINT (Fextent_start_position (obj)), + XINT (Fextent_end_position (obj))); bp += strlen (bp); *bp++ = (extent_end_open_p (anc) ? ')': ']'); if (!NILP (extent_end_glyph (anc))) *bp++ = '*'; @@ -2993,7 +2991,7 @@ print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) write_c_string (" ", printcharfun); } - sprintf (buf, "0x%lx", (unsigned long int) ext); + sprintf (buf, "0x%lx", (long) ext); write_c_string (buf, printcharfun); } @@ -3002,13 +3000,13 @@ print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { if (escapeflag) { - CONST char *title = ""; - CONST char *name = ""; - CONST char *posttitle = ""; + const char *title = ""; + const char *name = ""; + const char *posttitle = ""; Lisp_Object obj2 = Qnil; /* Destroyed extents have 't' in the object field, causing - extent_object() to abort (maybe). */ + extent_object() to ABORT (maybe). */ if (EXTENT_LIVE_P (XEXTENT (obj))) obj2 = extent_object (XEXTENT (obj)); @@ -3040,8 +3038,8 @@ print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) if (!EXTENT_LIVE_P (XEXTENT (obj))) error ("printing unreadable object #"); else - error ("printing unreadable object #", - XEXTENT (obj)); + error ("printing unreadable object #", + (long) XEXTENT (obj)); } if (!EXTENT_LIVE_P (XEXTENT (obj))) @@ -3104,13 +3102,13 @@ properties_equal (EXTENT e1, EXTENT e2, int depth) } static int -extent_equal (Lisp_Object o1, Lisp_Object o2, int depth) +extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct extent *e1 = XEXTENT (o1); - struct extent *e2 = XEXTENT (o2); + struct extent *e1 = XEXTENT (obj1); + struct extent *e2 = XEXTENT (obj2); return (extent_start (e1) == extent_start (e2) && - extent_end (e1) == extent_end (e2) && + extent_end (e1) == extent_end (e2) && internal_equal (extent_object (e1), extent_object (e2), depth + 1) && properties_equal (extent_ancestor (e1), extent_ancestor (e2), depth)); @@ -3126,6 +3124,13 @@ extent_hash (Lisp_Object obj, int depth) internal_hash (extent_object (e), depth + 1)); } +static const struct lrecord_description extent_description[] = { + { XD_LISP_OBJECT, offsetof (struct extent, object) }, + { XD_LISP_OBJECT, offsetof (struct extent, flags.face) }, + { XD_LISP_OBJECT, offsetof (struct extent, plist) }, + { XD_END } +}; + static Lisp_Object extent_getprop (Lisp_Object obj, Lisp_Object prop) { @@ -3156,6 +3161,8 @@ extent_remprop (Lisp_Object obj, Lisp_Object prop) || EQ (prop, Qpriority) || EQ (prop, Qface) || EQ (prop, Qinitial_redisplay_function) + || EQ (prop, Qafter_change_functions) + || EQ (prop, Qbefore_change_functions) || EQ (prop, Qmouse_face) || EQ (prop, Qhighlight) || EQ (prop, Qbegin_glyph_layout) @@ -3173,7 +3180,7 @@ extent_remprop (Lisp_Object obj, Lisp_Object prop) return -1; } - return external_remprop (&ext->plist, prop, 0, ERROR_ME); + return external_remprop (extent_plist_addr (ext), prop, 0, ERROR_ME); } static Lisp_Object @@ -3182,6 +3189,20 @@ extent_plist (Lisp_Object obj) return Fextent_properties (obj); } +DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent, + mark_extent, + print_extent, + /* NOTE: If you declare a + finalization method here, + it will NOT be called. + Shaft city. */ + 0, + extent_equal, extent_hash, + extent_description, + extent_getprop, extent_putprop, + extent_remprop, extent_plist, + struct extent); + /************************************************************************/ /* basic extent accessors */ @@ -3234,8 +3255,8 @@ decode_extent (Lisp_Object extent_obj, unsigned int flags) if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER)) || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED))) { - signal_simple_error ("extent doesn't belong to a buffer or string", - extent_obj); + invalid_argument ("extent doesn't belong to a buffer or string", + extent_obj); } return extent; @@ -3415,7 +3436,7 @@ DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /* Return the next position after POS where an extent begins or ends. If POS is at the end of the buffer or string, POS will be returned; otherwise a position greater than POS will always be returned. -If BUFFER is nil, the current buffer is assumed. +If OBJECT is nil, the current buffer is assumed. */ (pos, object)) { @@ -3525,7 +3546,9 @@ See `extent-parent'. return Qnil; for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest))) if (EQ (rest, extent)) - signal_simple_error ("Circular parent chain would result", extent); + signal_type_error (Qinvalid_change, + "Circular parent chain would result", + extent); if (NILP (parent)) { remove_extent_from_children_list (XEXTENT (cur_parent), extent); @@ -3663,7 +3686,7 @@ copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object) one. */ struct extent_auxiliary *data = alloc_lcrecord_type (struct extent_auxiliary, - lrecord_extent_auxiliary); + &lrecord_extent_auxiliary); copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist))); XSETEXTENT_AUXILIARY (XCAR (e->plist), data); @@ -3830,6 +3853,7 @@ See documentation on `detach-extent' for a discussion of undo recording. get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, GB_ALLOW_PAST_ACCESSIBLE); + buffer_or_string_extent_info_force (buffer_or_string); set_extent_endpoints (ext, s, e, buffer_or_string); return extent; } @@ -3888,7 +3912,7 @@ decode_map_extents_flags (Lisp_Object flags) EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION : EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION : EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION : - (signal_simple_error ("Invalid `map-extents' flag", sym), 0); + (invalid_argument ("Invalid `map-extents' flag", sym), 0); flags = XCDR (flags); } @@ -4226,11 +4250,12 @@ Thus, this function may be used to walk a tree of extents in a buffer: struct extent_at_arg { - EXTENT best_match; + Lisp_Object best_match; /* or list of extents */ Memind best_start; Memind best_end; Lisp_Object prop; EXTENT before; + int all_extents; }; enum extent_at_flag @@ -4251,7 +4276,7 @@ decode_extent_at_flag (Lisp_Object at_flag) if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE; if (EQ (at_flag, Qat)) return EXTENT_AT_AT; - signal_simple_error ("Invalid AT-FLAG in `extent-at'", at_flag); + invalid_argument ("Invalid AT-FLAG in `extent-at'", at_flag); return EXTENT_AT_AFTER; /* unreached */ } @@ -4273,13 +4298,15 @@ extent_at_mapper (EXTENT e, void *arg) return 0; } + if (!closure->all_extents) { - EXTENT current = closure->best_match; + EXTENT current; - if (!current) + if (NILP (closure->best_match)) goto accept; + current = XEXTENT (closure->best_match); /* redundant but quick test */ - else if (extent_start (current) > extent_start (e)) + if (extent_start (current) > extent_start (e)) return 0; /* we return the "last" best fit, instead of the first -- @@ -4292,20 +4319,27 @@ extent_at_mapper (EXTENT e, void *arg) else return 0; accept: - closure->best_match = e; + XSETEXTENT (closure->best_match, e); closure->best_start = extent_start (e); closure->best_end = extent_end (e); } + else + { + Lisp_Object extent; + + XSETEXTENT (extent, e); + closure->best_match = Fcons (extent, closure->best_match); + } return 0; } static Lisp_Object extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property, - EXTENT before, enum extent_at_flag at_flag) + EXTENT before, enum extent_at_flag at_flag, int all_extents) { struct extent_at_arg closure; - Lisp_Object extent_obj; + struct gcpro gcpro1; /* it might be argued that invalid positions should cause errors, but the principle of least surprise dictates that @@ -4323,20 +4357,21 @@ extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property, : position > buffer_or_string_absolute_end_byte (object))) return Qnil; - closure.best_match = 0; + closure.best_match = Qnil; closure.prop = property; closure.before = before; + closure.all_extents = all_extents; + GCPRO1 (closure.best_match); map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position, at_flag == EXTENT_AT_AFTER ? position + 1 : position, extent_at_mapper, (void *) &closure, object, 0, ME_START_OPEN | ME_ALL_EXTENTS_CLOSED); + if (all_extents) + closure.best_match = Fnreverse (closure.best_match); + UNGCPRO; - if (!closure.best_match) - return Qnil; - - XSETEXTENT (extent_obj, closure.best_match); - return extent_obj; + return closure.best_match; } DEFUN ("extent-at", Fextent_at, 1, 5, 0, /* @@ -4380,10 +4415,60 @@ you should use `map-extents', which gives you more control. else before_extent = decode_extent (before, DE_MUST_BE_ATTACHED); if (before_extent && !EQ (object, extent_object (before_extent))) - signal_simple_error ("extent not in specified buffer or string", object); + invalid_argument ("extent not in specified buffer or string", object); fl = decode_extent_at_flag (at_flag); - return extent_at_bytind (position, object, property, before_extent, fl); + return extent_at_bytind (position, object, property, before_extent, fl, 0); +} + +DEFUN ("extents-at", Fextents_at, 1, 5, 0, /* +Find all extents at POS in OBJECT having PROPERTY set. +Normally, an extent is "at" POS if it overlaps the region (POS, POS+1); + i.e. if it covers the character after POS. (However, see the definition + of AT-FLAG.) +This provides similar functionality to `extent-list', but does so in a way + that is compatible with `extent-at'. (For example, errors due to POS out of + range are ignored; this makes it safer to use this function in response to + a mouse event, because in many cases previous events have changed the buffer + contents.) +OBJECT specifies a buffer or string and defaults to the current buffer. +PROPERTY defaults to nil, meaning that any extent will do. +Properties are attached to extents with `set-extent-property', which see. +Returns nil if POS is invalid or there is no matching extent at POS. +If the fourth argument BEFORE is not nil, it must be an extent; any returned + extent will precede that extent. This feature allows `extents-at' to be + used by a loop over extents. +AT-FLAG controls how end cases are handled, and should be one of: + +nil or `after' An extent is at POS if it covers the character + after POS. This is consistent with the way + that text properties work. +`before' An extent is at POS if it covers the character + before POS. +`at' An extent is at POS if it overlaps or abuts POS. + This includes all zero-length extents at POS. + +Note that in all cases, the start-openness and end-openness of the extents +considered is ignored. If you want to pay attention to those properties, +you should use `map-extents', which gives you more control. +*/ + (pos, object, property, before, at_flag)) +{ + Bytind position; + EXTENT before_extent; + enum extent_at_flag fl; + + object = decode_buffer_or_string (object); + position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); + if (NILP (before)) + before_extent = 0; + else + before_extent = decode_extent (before, DE_MUST_BE_ATTACHED); + if (before_extent && !EQ (object, extent_object (before_extent))) + invalid_argument ("extent not in specified buffer or string", object); + fl = decode_extent_at_flag (at_flag); + + return extent_at_bytind (position, object, property, before_extent, fl, 1); } /* ------------------------------- */ @@ -4493,34 +4578,43 @@ process_extents_for_insertion_mapper (EXTENT extent, void *arg) #ifdef ERROR_CHECK_EXTENTS if (extent_start (extent) > indice && extent_start (extent) < indice + closure->length) - abort (); + ABORT (); if (extent_end (extent) > indice && extent_end (extent) < indice + closure->length) - abort (); + ABORT (); #endif /* The extent-adjustment code adjusted the extent's endpoints as if - they were markers -- endpoints at the gap (i.e. the insertion - point) go to the left of the insertion point, which is correct - for [) extents. We need to fix the other kinds of extents. + all extents were closed-open -- endpoints at the insertion point + remain unchanged. We need to fix the other kinds of extents: + + 1. Start position of start-open extents needs to be moved. + + 2. End position of end-closed extents needs to be moved. - Note that both conditions below will hold for zero-length (] - extents at the gap. Zero-length () extents would get adjusted - such that their start is greater than their end; we treat them - as [) extents. This is unfortunately an inelegant part of the - extent model, but there is no way around it. */ + Note that both conditions hold for zero-length (] extents at the + insertion point. But under these rules, zero-length () extents + would get adjusted such that their start is greater than their + end; instead of allowing that, we treat them as [) extents by + modifying condition #1 to not fire nothing when dealing with a + zero-length open-open extent. + + Existence of zero-length open-open extents is unfortunately an + inelegant part of the extent model, but there is no way around + it. */ { - Memind new_start, new_end; + Memind new_start = extent_start (extent); + Memind new_end = extent_end (extent); - new_start = extent_start (extent); - new_end = extent_end (extent); - if (indice == extent_start (extent) && extent_start_open_p (extent) && - /* coerce zero-length () extents to [) */ - new_start != new_end) + if (indice == extent_start (extent) && extent_start_open_p (extent) + /* zero-length () extents are exempt; see comment above. */ + && !(new_start == new_end && extent_end_open_p (extent)) + ) new_start += closure->length; if (indice == extent_end (extent) && !extent_end_open_p (extent)) new_end += closure->length; + set_extent_endpoints_1 (extent, new_start, new_end); } @@ -4602,6 +4696,99 @@ process_extents_for_deletion (Lisp_Object object, Bytind from, ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS); } +/* ------------------------------- */ +/* report_extent_modification() */ +/* ------------------------------- */ +struct report_extent_modification_closure { + Lisp_Object buffer; + Bufpos start, end; + int afterp; + int speccount; +}; + +static Lisp_Object +report_extent_modification_restore (Lisp_Object buffer) +{ + if (current_buffer != XBUFFER (buffer)) + Fset_buffer (buffer); + return Qnil; +} + +static int +report_extent_modification_mapper (EXTENT extent, void *arg) +{ + struct report_extent_modification_closure *closure = + (struct report_extent_modification_closure *)arg; + Lisp_Object exobj, startobj, endobj; + Lisp_Object hook = (closure->afterp + ? extent_after_change_functions (extent) + : extent_before_change_functions (extent)); + if (NILP (hook)) + return 0; + + XSETEXTENT (exobj, extent); + XSETINT (startobj, closure->start); + XSETINT (endobj, closure->end); + + /* Now that we are sure to call elisp, set up an unwind-protect so + inside_change_hook gets restored in case we throw. Also record + the current buffer, in case we change it. Do the recording only + once. + + One confusing thing here is that our caller never actually calls + unbind_to (closure.speccount, Qnil). This is because + map_extents_bytind() unbinds before, and with a smaller + speccount. The additional unbind_to() in + report_extent_modification() would cause XEmacs to ABORT. */ + if (closure->speccount == -1) + { + closure->speccount = specpdl_depth (); + record_unwind_protect (report_extent_modification_restore, + Fcurrent_buffer ()); + } + + /* The functions will expect closure->buffer to be the current + buffer, so change it if it isn't. */ + if (current_buffer != XBUFFER (closure->buffer)) + Fset_buffer (closure->buffer); + + /* #### It's a shame that we can't use any of the existing run_hook* + functions here. This is so because all of them work with + symbols, to be able to retrieve default values of local hooks. + + + #### Idea: we could set up a dummy symbol, and call the hook + functions on *that*. */ + + if (!CONSP (hook) || EQ (XCAR (hook), Qlambda)) + call3 (hook, exobj, startobj, endobj); + else + { + Lisp_Object tail; + EXTERNAL_LIST_LOOP (tail, hook) + /* #### Shouldn't this perform the same Fset_buffer() check as + above? */ + call3 (XCAR (tail), exobj, startobj, endobj); + } + return 0; +} + +void +report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end, + int afterp) +{ + struct report_extent_modification_closure closure; + + closure.buffer = buffer; + closure.start = start; + closure.end = end; + closure.afterp = afterp; + closure.speccount = -1; + + map_extents (start, end, report_extent_modification_mapper, (void *)&closure, + buffer, NULL, ME_MIGHT_CALL_ELISP); +} + /************************************************************************/ /* extent properties */ @@ -4645,7 +4832,7 @@ memoize_extent_face_internal (Lisp_Object list) on the keys so the memoization works correctly. Note that we canonicalize things so that the keys in the - hashtable (the external lists) always contain symbols and + hash table (the external lists) always contain symbols and the values (the internal lists) always contain face objects. We also maintain a "reverse" table that maps from the internal @@ -4749,7 +4936,7 @@ canonicalize_extent_property (Lisp_Object prop, Lisp_Object value) /* Do we need a lisp-level function ? */ DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function, - 2,2,0,/* + 2,2,0, /* Note: This feature is experimental! Set initial-redisplay-function of EXTENT to the function @@ -4878,7 +5065,7 @@ glyph_layout_to_symbol (glyph_layout layout) case GL_INSIDE_MARGIN: return Qinside_margin; case GL_WHITESPACE: return Qwhitespace; default: - abort (); + ABORT (); return Qnil; /* unreached */ } } @@ -4895,7 +5082,7 @@ symbol_to_glyph_layout (Lisp_Object layout_obj) if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE; if (EQ (layout_obj, Qtext)) return GL_TEXT; - signal_simple_error ("unknown glyph layout type", layout_obj); + invalid_argument ("Unknown glyph layout type", layout_obj); return GL_TEXT; /* unreached */ } @@ -4903,13 +5090,13 @@ static Lisp_Object set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp, Lisp_Object layout_obj) { - EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER); + EXTENT extent = decode_extent (extent_obj, 0); glyph_layout layout = symbol_to_glyph_layout (layout_obj); - /* Make sure we've actually been given a glyph or it's nil (meaning - we're deleting a glyph from an extent). */ + /* Make sure we've actually been given a valid glyph or it's nil + (meaning we're deleting a glyph from an extent). */ if (!NILP (glyph)) - CHECK_GLYPH (glyph); + CHECK_BUFFER_GLYPH (glyph); set_extent_glyph (extent, glyph, endp, layout); return glyph; @@ -5165,7 +5352,14 @@ The following symbols have predefined meanings: `inside-margin', or `outside-margin') of the extent's begin glyph. - end-glyph-layout The layout policy of the extent's end glyph. + end-glyph-layout The layout policy of the extent's end glyph. + + syntax-table A cons or a syntax table object. If a cons, the car must + be an integer (interpreted as a syntax code, applicable to + all characters in the extent). Otherwise, syntax of + characters in the extent is looked up in the syntax table. + You should use the text property API to manipulate this + property. (This may be required in the future.) */ (extent, property, value)) { @@ -5201,6 +5395,10 @@ The following symbols have predefined meanings: Fset_extent_face (extent, value); else if (EQ (property, Qinitial_redisplay_function)) Fset_extent_initial_redisplay_function (extent, value); + else if (EQ (property, Qbefore_change_functions)) + set_extent_before_change_functions (e, value); + else if (EQ (property, Qafter_change_functions)) + set_extent_after_change_functions (e, value); else if (EQ (property, Qmouse_face)) Fset_extent_mouse_face (extent, value); /* Obsolete: */ @@ -5218,23 +5416,15 @@ The following symbols have predefined meanings: Fset_extent_begin_glyph (extent, value, Qnil); else if (EQ (property, Qend_glyph)) Fset_extent_end_glyph (extent, value, Qnil); - else if (EQ (property, Qstart_open) || - EQ (property, Qend_open) || - EQ (property, Qstart_closed) || - EQ (property, Qend_closed)) - { - int start_open = -1, end_open = -1; - if (EQ (property, Qstart_open)) - start_open = !NILP (value); - else if (EQ (property, Qend_open)) - end_open = !NILP (value); - /* Support (but don't document...) the obvious antonyms. */ - else if (EQ (property, Qstart_closed)) - start_open = NILP (value); - else - end_open = NILP (value); - set_extent_openness (e, start_open, end_open); - } + else if (EQ (property, Qstart_open)) + set_extent_openness (e, !NILP (value), -1); + else if (EQ (property, Qend_open)) + set_extent_openness (e, -1, !NILP (value)); + /* Support (but don't document...) the obvious *_closed antonyms. */ + else if (EQ (property, Qstart_closed)) + set_extent_openness (e, NILP (value), -1); + else if (EQ (property, Qend_closed)) + set_extent_openness (e, -1, NILP (value)); else { if (EQ (property, Qkeymap)) @@ -5274,24 +5464,28 @@ For a list of built-in properties, see `set-extent-property'. DEFUN ("extent-property", Fextent_property, 2, 3, 0, /* Return EXTENT's value for property PROPERTY. +If no such property exists, DEFAULT is returned. See `set-extent-property' for the built-in property names. */ (extent, property, default_)) { EXTENT e = decode_extent (extent, 0); - if (EQ (property, Qdetached)) + if (EQ (property, Qdetached)) return extent_detached_p (e) ? Qt : Qnil; else if (EQ (property, Qdestroyed)) return !EXTENT_LIVE_P (e) ? Qt : Qnil; -#define RETURN_FLAG(flag) return extent_normal_field (e, flag) ? Qt : Qnil - else if (EQ (property, Qstart_open)) RETURN_FLAG (start_open); - else if (EQ (property, Qend_open)) RETURN_FLAG (end_open); - else if (EQ (property, Qunique)) RETURN_FLAG (unique); - else if (EQ (property, Qduplicable)) RETURN_FLAG (duplicable); - else if (EQ (property, Qdetachable)) RETURN_FLAG (detachable); -#undef RETURN_FLAG - /* Support (but don't document...) the obvious antonyms. */ + else if (EQ (property, Qstart_open)) + return extent_normal_field (e, start_open) ? Qt : Qnil; + else if (EQ (property, Qend_open)) + return extent_normal_field (e, end_open) ? Qt : Qnil; + else if (EQ (property, Qunique)) + return extent_normal_field (e, unique) ? Qt : Qnil; + else if (EQ (property, Qduplicable)) + return extent_normal_field (e, duplicable) ? Qt : Qnil; + else if (EQ (property, Qdetachable)) + return extent_normal_field (e, detachable) ? Qt : Qnil; + /* Support (but don't document...) the obvious *_closed antonyms. */ else if (EQ (property, Qstart_closed)) return extent_start_open_p (e) ? Qnil : Qt; else if (EQ (property, Qend_closed)) @@ -5306,6 +5500,10 @@ See `set-extent-property' for the built-in property names. return Fextent_face (extent); else if (EQ (property, Qinitial_redisplay_function)) return extent_initial_redisplay_function (e); + else if (EQ (property, Qbefore_change_functions)) + return extent_before_change_functions (e); + else if (EQ (property, Qafter_change_functions)) + return extent_after_change_functions (e); else if (EQ (property, Qmouse_face)) return Fextent_mouse_face (extent); /* Obsolete: */ @@ -5382,6 +5580,14 @@ Do not modify this list; use `set-extent-property' instead. result = cons3 (Qinitial_redisplay_function, extent_initial_redisplay_function (anc), result); + if (!NILP (extent_before_change_functions (anc))) + result = cons3 (Qbefore_change_functions, + extent_before_change_functions (anc), result); + + if (!NILP (extent_after_change_functions (anc))) + result = cons3 (Qafter_change_functions, + extent_after_change_functions (anc), result); + if (!NILP (extent_invisible (anc))) result = cons3 (Qinvisible, extent_invisible (anc), result); @@ -5636,12 +5842,10 @@ add_string_extents_mapper (EXTENT extent, void *arg) struct add_string_extents_arg *closure = (struct add_string_extents_arg *) arg; Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from; - Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from; + Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from; if (extent_duplicable_p (extent)) { - EXTENT e; - start = max (start, 0); end = min (end, closure->length); @@ -5652,7 +5856,7 @@ add_string_extents_mapper (EXTENT extent, void *arg) !run_extent_copy_function (extent, start + closure->from, end + closure->from)) return 0; - e = copy_extent (extent, start, end, closure->string); + copy_extent (extent, start, end, closure->string); } return 0; @@ -5777,25 +5981,21 @@ copy_string_extents_mapper (EXTENT extent, void *arg) { struct copy_string_extents_arg *closure = (struct copy_string_extents_arg *) arg; - Bytecount old_start, old_end; - Bytecount new_start, new_end; + Bytecount old_start, old_end, new_start, new_end; old_start = extent_endpoint_bytind (extent, 0); - old_end = extent_endpoint_bytind (extent, 1); + old_end = extent_endpoint_bytind (extent, 1); old_start = max (closure->old_pos, old_start); - old_end = min (closure->old_pos + closure->length, old_end); + old_end = min (closure->old_pos + closure->length, old_end); if (old_start >= old_end) return 0; new_start = old_start + closure->new_pos - closure->old_pos; - new_end = old_end + closure->new_pos - closure->old_pos; + new_end = old_end + closure->new_pos - closure->old_pos; - copy_extent (extent, - old_start + closure->new_pos - closure->old_pos, - old_end + closure->new_pos - closure->old_pos, - closure->new_string); + copy_extent (extent, new_start, new_end, closure->new_string); return 0; } @@ -5856,14 +6056,14 @@ get_text_property_bytind (Bytind position, Lisp_Object prop, /* text_props_only specifies whether we only consider text-property extents (those with the 'text-prop property set) or all extents. */ if (!text_props_only) - extent = extent_at_bytind (position, object, prop, 0, fl); + extent = extent_at_bytind (position, object, prop, 0, fl, 0); else { EXTENT prior = 0; while (1) { extent = extent_at_bytind (position, object, Qtext_prop, prior, - fl); + fl, 0); if (NILP (extent)) return Qnil; if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil))) @@ -6395,7 +6595,8 @@ Used as the `paste-function' property of `text-prop' extents. prop = Fextent_property (extent, Qtext_prop, Qnil); if (NILP (prop)) - signal_simple_error ("internal error: no text-prop", extent); + signal_type_error (Qinternal_error, + "Internal error: no text-prop", extent); val = Fextent_property (extent, prop, Qnil); #if 0 /* removed by bill perry, 2/9/97 @@ -6403,8 +6604,9 @@ Used as the `paste-function' property of `text-prop' extents. ** with a value of Qnil. This is bad bad bad. */ if (NILP (val)) - signal_simple_error_2 ("internal error: no text-prop", - extent, prop); + signal_type_error_2 (Qinternal_error, + "Internal error: no text-prop", + extent, prop); #endif Fput_text_property (from, to, prop, val, Qnil); return Qnil; /* important! */ @@ -6422,7 +6624,7 @@ Scans characters forward from POS till it finds a change in the PROP argument OBJECT is the buffer or string to scan (defaults to the current buffer). The property values are compared with `eq'. -Return nil if the property is constant all the way to the end of BUFFER. +Return nil if the property is constant all the way to the end of OBJECT. If the value is non-nil, it is a position greater than POS, never equal. If the optional fourth argument LIMIT is non-nil, don't search @@ -6489,7 +6691,7 @@ Scans characters backward from POS till it finds a change in the PROP argument OBJECT is the buffer or string to scan (defaults to the current buffer). The property values are compared with `eq'. -Return nil if the property is constant all the way to the start of BUFFER. +Return nil if the property is constant all the way to the start of OBJECT. If the value is non-nil, it is a position less than POS, never equal. If the optional fourth argument LIMIT is non-nil, don't search back @@ -6568,6 +6770,10 @@ compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats) void syms_of_extents (void) { + INIT_LRECORD_IMPLEMENTATION (extent); + INIT_LRECORD_IMPLEMENTATION (extent_info); + INIT_LRECORD_IMPLEMENTATION (extent_auxiliary); + defsymbol (&Qextentp, "extentp"); defsymbol (&Qextent_live_p, "extent-live-p"); @@ -6607,8 +6813,6 @@ syms_of_extents (void) defsymbol (&Qwhitespace, "whitespace"); /* Qtext defined in general.c */ - defsymbol (&Qglyph_invisible, "glyph-invisible"); - defsymbol (&Qpaste_function, "paste-function"); defsymbol (&Qcopy_function, "copy-function"); @@ -6646,6 +6850,7 @@ syms_of_extents (void) DEFSUBR (Fmap_extents); DEFSUBR (Fmap_extent_children); DEFSUBR (Fextent_at); + DEFSUBR (Fextents_at); DEFSUBR (Fset_extent_initial_redisplay_function); DEFSUBR (Fextent_face); @@ -6685,8 +6890,26 @@ syms_of_extents (void) } void +reinit_vars_of_extents (void) +{ + extent_auxiliary_defaults.begin_glyph = Qnil; + extent_auxiliary_defaults.end_glyph = Qnil; + extent_auxiliary_defaults.parent = Qnil; + extent_auxiliary_defaults.children = Qnil; + extent_auxiliary_defaults.priority = 0; + extent_auxiliary_defaults.invisible = Qnil; + extent_auxiliary_defaults.read_only = Qnil; + extent_auxiliary_defaults.mouse_face = Qnil; + extent_auxiliary_defaults.initial_redisplay_function = Qnil; + extent_auxiliary_defaults.before_change_functions = Qnil; + extent_auxiliary_defaults.after_change_functions = Qnil; +} + +void vars_of_extents (void) { + reinit_vars_of_extents (); + DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /* The priority to use for the mouse-highlighting pseudo-extent that is used to highlight extents with the `mouse-face' attribute set. @@ -6695,7 +6918,7 @@ See `set-extent-priority'. /* Set mouse-highlight-priority (which ends up being used both for the mouse-highlighting pseudo-extent and the primary selection extent) to a very high value because very few extents should override it. - 1000 gives lots of room below it for different-prioritied extents. + 1000 gives lots of room below it for different-prioritized extents. 10 doesn't. ediff, for example, likes to use priorities around 100. --ben */ mouse_highlight_priority = /* 10 */ 1000; @@ -6713,30 +6936,20 @@ functions `get-text-property' or `get-char-property' are called. Vextent_face_reusable_list = Fcons (Qnil, Qnil); staticpro (&Vextent_face_reusable_list); - - extent_auxiliary_defaults.begin_glyph = Qnil; - extent_auxiliary_defaults.end_glyph = Qnil; - extent_auxiliary_defaults.parent = Qnil; - extent_auxiliary_defaults.children = Qnil; - extent_auxiliary_defaults.priority = 0; - extent_auxiliary_defaults.invisible = Qnil; - extent_auxiliary_defaults.read_only = Qnil; - extent_auxiliary_defaults.mouse_face = Qnil; - extent_auxiliary_defaults.initial_redisplay_function = Qnil; } void complex_vars_of_extents (void) { staticpro (&Vextent_face_memoize_hash_table); - /* The memoize hash-table maps from lists of symbols to lists of + /* The memoize hash table maps from lists of symbols to lists of faces. It needs to be `equal' to implement the memoization. The reverse table maps in the other direction and just needs to do `eq' comparison because the lists of faces are already memoized. */ Vextent_face_memoize_hash_table = - make_lisp_hashtable (100, HASHTABLE_VALUE_WEAK, HASHTABLE_EQUAL); + make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); staticpro (&Vextent_face_reverse_memoize_hash_table); Vextent_face_reverse_memoize_hash_table = - make_lisp_hashtable (100, HASHTABLE_KEY_WEAK, HASHTABLE_EQ); + make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); }