X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fextents.c;h=a79f7d615628d406fa6a730275e97298517c2386;hb=7b4b1b26bb371112bf3e18732864bc08584127b6;hp=5fd8ad5367fa5e4bea4b71dbf4b3f91513412369;hpb=a1655b870904de973c366d85ebdc8adde4ef5e1e;p=chise%2Fxemacs-chise.git- diff --git a/src/extents.c b/src/extents.c index 5fd8ad5..a79f7d6 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. @@ -1599,8 +1599,8 @@ extent_changed_for_redisplay (EXTENT extent, int descendants_too, else if (STRINGP (object)) { /* #### Changes to string extents can affect redisplay if they are - in the modeline or in the gutters. - + 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 @@ -1609,7 +1609,7 @@ extent_changed_for_redisplay (EXTENT extent, int descendants_too, 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. + 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 @@ -1860,7 +1860,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, @@ -1895,7 +1895,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; } @@ -3245,8 +3245,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; @@ -3426,7 +3426,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)) { @@ -3536,7 +3536,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); @@ -3899,7 +3901,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); } @@ -4237,11 +4239,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 @@ -4262,7 +4265,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 */ } @@ -4284,13 +4287,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 -- @@ -4303,20 +4308,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 @@ -4334,20 +4346,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, /* @@ -4391,10 +4404,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, 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); + return extent_at_bytind (position, object, property, before_extent, fl, 1); } /* ------------------------------- */ @@ -4853,7 +4916,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 @@ -4999,7 +5062,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 */ } @@ -5374,6 +5437,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_)) @@ -5965,14 +6029,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))) @@ -6504,7 +6568,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 @@ -6512,8 +6577,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! */ @@ -6531,7 +6597,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 @@ -6598,7 +6664,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 @@ -6757,6 +6823,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);