X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fextents.c;h=be980e98133742883f8d494167b8e917a6eb1186;hb=a94c84beadc87325e2bfa14f85ab48fe5d965c36;hp=6360a4d81c9dcc348842579856ffe662946f28c0;hpb=976b002b16336930724ae22476014583ad022e7d;p=chise%2Fxemacs-chise.git.1 diff --git a/src/extents.c b/src/extents.c index 6360a4d..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. @@ -227,6 +227,7 @@ Boston, MA 02111-1307, USA. */ #include "opaque.h" #include "process.h" #include "redisplay.h" +#include "gutter.h" /* ------------------------------- */ /* gap array */ @@ -260,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 @@ -301,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)) && \ @@ -405,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; @@ -444,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; @@ -464,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 */ @@ -890,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; } @@ -910,24 +911,24 @@ 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); - markobj (data->before_change_functions); - markobj (data->after_change_functions); + 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) @@ -973,7 +974,7 @@ 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); int i; @@ -996,7 +997,7 @@ mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object)) Lisp_Object exobj; XSETEXTENT (exobj, extent); - markobj (exobj); + mark_object (exobj); } } @@ -1025,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 @@ -1174,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); } } @@ -1540,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); } @@ -1553,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); } @@ -1594,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 hash table? - 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. @@ -1847,7 +1861,7 @@ extent_in_region_p (EXTENT extent, Bytind from, Bytind to, 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(); break; + default: ABORT(); return 0; } start = buffer_or_string_bytind_to_startind (obj, from, @@ -1882,7 +1896,7 @@ extent_in_region_p (EXTENT extent, Bytind from, Bytind to, retval = (start <= exs && exs <= end) || (start <= exe && exe <= end); break; default: - abort(); break; + ABORT(); return 0; } return flags & ME_NEGATE_IN_REGION ? !retval : retval; } @@ -2602,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); @@ -2741,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; @@ -2784,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; } } @@ -2799,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; } } @@ -2913,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; } @@ -2962,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++ = '*'; @@ -3004,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)); @@ -3128,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) { @@ -3177,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 @@ -3186,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 */ @@ -3238,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; @@ -3419,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)) { @@ -3529,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); @@ -3834,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; } @@ -3892,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); } @@ -4230,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 @@ -4255,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 */ } @@ -4277,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 -- @@ -4296,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 @@ -4327,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, /* @@ -4384,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); } /* ------------------------------- */ @@ -4497,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: - 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. */ + 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 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); } @@ -4616,14 +4706,9 @@ struct report_extent_modification_closure { int speccount; }; -/* This juggling with the pointer to another file's global variable is - kind of yucky. Perhaps I should just export the variable. */ -static int *inside_change_hook_pointer; - static Lisp_Object report_extent_modification_restore (Lisp_Object buffer) { - *inside_change_hook_pointer = 0; if (current_buffer != XBUFFER (buffer)) Fset_buffer (buffer); return Qnil; @@ -4648,7 +4733,13 @@ report_extent_modification_mapper (EXTENT extent, void *arg) /* 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. */ + 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 (); @@ -4664,7 +4755,10 @@ report_extent_modification_mapper (EXTENT extent, void *arg) /* #### 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); @@ -4672,6 +4766,8 @@ report_extent_modification_mapper (EXTENT extent, void *arg) { 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; @@ -4679,7 +4775,7 @@ report_extent_modification_mapper (EXTENT extent, void *arg) void report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end, - int *inside, int afterp) + int afterp) { struct report_extent_modification_closure closure; @@ -4689,20 +4785,8 @@ report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end, closure.afterp = afterp; closure.speccount = -1; - inside_change_hook_pointer = inside; - *inside = 1; - map_extents (start, end, report_extent_modification_mapper, (void *)&closure, buffer, NULL, ME_MIGHT_CALL_ELISP); - - if (closure.speccount == -1) - *inside = 0; - else - { - /* We mustn't unbind when closure.speccount != -1 because - map_extents_bytind has already done that. */ - assert (*inside == 0); - } } @@ -4852,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 @@ -4981,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 */ } } @@ -4998,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 */ } @@ -5006,7 +5090,7 @@ 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 valid glyph or it's nil @@ -5268,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)) { @@ -5373,6 +5464,7 @@ 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_)) @@ -5964,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))) @@ -6503,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 @@ -6511,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! */ @@ -6530,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 @@ -6597,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 @@ -6676,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"); @@ -6715,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"); @@ -6754,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); @@ -6793,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. @@ -6821,18 +6936,6 @@ 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; - extent_auxiliary_defaults.before_change_functions = Qnil; - extent_auxiliary_defaults.after_change_functions = Qnil; } void