/* 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.
#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 */
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
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)) && \
#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;
Lisp_Object Qwhitespace;
/* Qtext defined in general.c */
-/* partially used in redisplay */
-Lisp_Object Qglyph_invisible;
-
Lisp_Object Qcopy_function;
Lisp_Object Qpaste_function;
/* 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;
+
\f
/************************************************************************/
/* Generalized gap array */
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,
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;
}
/************************************************************************/
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)
{
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);
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
(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++)
Lisp_Object exobj;
XSETEXTENT (exobj, extent);
- ((markobj) (exobj));
+ mark_object (exobj);
}
}
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);
\f
static Lisp_Object
{
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 ();
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);
}
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);
}
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.
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. */
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
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;
}
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);
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);
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;
}
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",
+ (long) XINT (Fextent_start_position (obj)),
+ (long) XINT (Fextent_end_position (obj)));
bp += strlen (bp);
*bp++ = (extent_end_open_p (anc) ? ')': ']');
if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
write_c_string (" ", printcharfun);
}
- sprintf (buf, "0x%lx", (unsigned long int) ext);
+ sprintf (buf, "0x%lx", (long) ext);
write_c_string (buf, printcharfun);
}
{
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
if (!EXTENT_LIVE_P (XEXTENT (obj)))
error ("printing unreadable object #<destroyed extent>");
else
- error ("printing unreadable object #<extent 0x%p>",
- XEXTENT (obj));
+ error ("printing unreadable object #<extent 0x%lx>",
+ (long) XEXTENT (obj));
}
if (!EXTENT_LIVE_P (XEXTENT (obj)))
}
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));
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)
{
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
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);
+
\f
/************************************************************************/
/* basic extent accessors */
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;
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))
{
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);
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);
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);
}
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
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 */
}
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 --
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
: 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, /*
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);
}
/* ------------------------------- */
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;
/* 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 ();
/* #### 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.
- <sigh> */
+ <sigh>
+
+ #### 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);
{
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 *inside, int afterp)
+ int afterp)
{
struct report_extent_modification_closure closure;
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);
- }
}
\f
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
/* 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
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 */
}
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;
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))
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))
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);
!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;
{
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;
}
/* 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)))
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
** 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! */
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
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
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");
defsymbol (&Qwhitespace, "whitespace");
/* Qtext defined in general.c */
- defsymbol (&Qglyph_invisible, "glyph-invisible");
-
defsymbol (&Qpaste_function, "paste-function");
defsymbol (&Qcopy_function, "copy-function");
DEFSUBR (Fmap_extents);
DEFSUBR (Fmap_extent_children);
DEFSUBR (Fextent_at);
+ DEFSUBR (Fextents_at);
DEFSUBR (Fset_extent_initial_redisplay_function);
DEFSUBR (Fextent_face);
}
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.
/* 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;
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
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);
}