Here is an experimental patch that adds extent modification hooks to
XEmacs. I'd like to hear what you think of the design and
implementation.
This patch is *not* meant for application to any XEmacs.
1998-09-04 Hrvoje Niksic <hniksic(a)srce.hr>
* insdel.c (change_function_restore): Reverse order of
function-call and assignment.
(first_change_hook_restore): Ditto.
* extents.c (mark_extent_auxiliary): Mark them.
(Fset_extent_property): Set them.
(Fextent_property): Get them.
(Fextent_properties): Ditto.
(vars_of_extents): Set their default.
* extents.h (struct extent_auxiliary): Add before_change_functions
and after_change_functions.
* insdel.c (signal_before_change): Use it.
(signal_after_change): Ditto.
* extents.c (report_extent_modification): New function.
* insdel.c (signal_before_change): Don't check for Armageddon.
(signal_after_change): Ditto.
--- src/insdel.c.orig Tue Sep 1 00:37:32 1998
+++ src/insdel.c Fri Sep 4 21:07:13 1998
＠＠ -2102,8 +2102,10 ＠＠
static Lisp_Object
change_function_restore (Lisp_Object buffer)
{
- Fset_buffer (buffer);
+ /* We should first reset the variable and then change the buffer,
+ because Fset_buffer() can throw. */
inside_change_hook = 0;
+ Fset_buffer (buffer);
return Qnil;
}
＠＠ -2112,8 +2114,8 ＠＠
static Lisp_Object
first_change_hook_restore (Lisp_Object buffer)
{
- Fset_buffer (buffer);
in_first_change = 0;
+ Fset_buffer (buffer);
return Qnil;
}
＠＠ -2185,10 +2187,9 ＠＠
/* Now in any case run the before-change-functions if any. */
- if (!preparing_for_armageddon &&
- (!NILP (symbol_value_in_buffer (Qbefore_change_functions, buffer)) ||
- /* Obsolete, for compatibility */
- !NILP (symbol_value_in_buffer (Qbefore_change_function, buffer))))
+ if (!NILP (symbol_value_in_buffer (Qbefore_change_functions, buffer))
+ /* Obsolete, for compatibility */
+ || !NILP (symbol_value_in_buffer (Qbefore_change_function, buffer)))
{
int speccount = specpdl_depth ();
record_unwind_protect (change_function_restore, Fcurrent_buffer ());
＠＠ -2202,14 +2203,13 ＠＠
unbind_to (speccount, Qnil);
}
+ report_extent_modification (buffer, start, end,
+ &inside_change_hook, 0);
+
/* Only now do we indicate that the before-change-functions have
been called, in case some function throws out. */
buf->text->changes->mc_begin_signaled = 1;
}
-
- /* #### At this point we should map over extents calling
- modification-hooks, insert-before-hooks and insert-after-hooks
- of relevant extents */
}
/* Signal a change immediately after it happens.
＠＠ -2243,10 +2243,9 ＠＠
return; /* after-change-functions signalled when all changes done */
}
- if (!preparing_for_armageddon &&
- (!NILP (symbol_value_in_buffer (Qafter_change_functions, buffer)) ||
+ if (!NILP (symbol_value_in_buffer (Qafter_change_functions, buffer))
/* Obsolete, for compatibility */
- !NILP (symbol_value_in_buffer (Qafter_change_function, buffer))))
+ || !NILP (symbol_value_in_buffer (Qafter_change_function, buffer)))
{
int speccount = specpdl_depth ();
record_unwind_protect (change_function_restore, Fcurrent_buffer ());
＠＠ -2263,10 +2262,10 ＠＠
make_int (orig_end - start));
unbind_to (speccount, Qnil);
}
- }
- /* #### At this point we should map over extents calling
- some sort of modification hooks of relevant extents */
+ report_extent_modification (buffer, start, new_end,
+ &inside_change_hook, 1);
+ }
}
/* Call this if you're about to change the region of BUFFER from START
--- src/extents.h.orig Fri Sep 4 19:49:26 1998
+++ src/extents.h Fri Sep 4 21:34:01 1998
＠＠ -82,17 +82,14 ＠＠
unsigned int has_aux :1; /* 6 extent has an aux. structure */
unsigned int start_open :1; /* 7 insertion behavior at start */
unsigned int end_open :1; /* 8 insertion behavior at end */
- unsigned int unused9 :1; /* 9 unused */
- unsigned int unique :1; /* 10 there may be only one attached */
- unsigned int duplicable :1; /* 11 copied to strings by kill/undo */
- unsigned int REPLICATING :1; /* 12 invoke old extent-replica behav.*/
- /* Not used any more */
- unsigned int detachable :1; /* 13 extent detaches if text deleted */
- unsigned int internal :1; /* 14 used by map-extents etc. */
- unsigned int in_red_event :1; /* 15 An event has been spawned for
+ unsigned int unique :1; /* 9 there may be only one attached */
+ unsigned int duplicable :1; /* 10 copied to strings by kill/undo */
+ unsigned int detachable :1; /* 11 extent detaches if text deleted */
+ unsigned int internal :1; /* 12 used by map-extents etc. */
+ unsigned int in_red_event :1; /* 13 An event has been spawned for
initial redisplay.
- Not exported to the lisp level */
- unsigned int unused16 :1; /* 16 unused */
+ (not exported to lisp) */
+ unsigned int unused16 :1; /* 16 unused bits */
/* --- Adding more flags will cause the extent struct to grow by another
word. It's not clear that this would make a difference, however,
because on 32-bit machines things tend to get allocated in chunks
＠＠ -139,6 +136,7 ＠＠
Lisp_Object read_only;
Lisp_Object mouse_face;
Lisp_Object initial_redisplay_function;
+ Lisp_Object before_change_functions, after_change_functions;
int priority;
};
＠＠ -230,6 +228,8 ＠＠
#define extent_read_only(e) extent_aux_field (e, read_only)
#define extent_mouse_face(e) extent_aux_field (e, mouse_face)
#define extent_initial_redisplay_function(e) extent_aux_field (e, initial_redisplay_function)
+#define extent_before_change_functions(e) extent_aux_field (e, before_change_functions)
+#define extent_after_change_functions(e) extent_aux_field (e, after_change_functions)
#define set_extent_begin_glyph(e, value) \
set_extent_aux_field (e, begin_glyph, value)
＠＠ -246,6 +246,10 ＠＠
/* Use Fset_extent_initial_redisplay_function unless you know what you're doing */
#define set_extent_initial_redisplay_function(e, value) \
set_extent_aux_field (e, initial_redisplay_function, value)
+#define set_extent_before_change_functions(e, value) \
+ set_extent_aux_field (e, before_change_functions, value)
+#define set_extent_after_change_functions(e, value) \
+ set_extent_aux_field (e, after_change_functions, value)
#define extent_face(e) extent_normal_field (e, face)
#define extent_begin_glyph_layout(e) extent_normal_field (e, begin_glyph_layout)
＠＠ -366,6 +370,7 ＠＠
Bytind opoint, Bytecount length);
void process_extents_for_deletion (Lisp_Object object, Bytind from,
Bytind to, int destroy_them);
+void report_extent_modification (Lisp_Object, Bufpos, Bufpos, int *, int);
void set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
glyph_layout layout);
--- src/extents.c.orig Fri Sep 4 16:37:03 1998
+++ src/extents.c Fri Sep 4 22:33:37 1998
＠＠ -921,6 +921,8 ＠＠
((markobj) (data->read_only));
((markobj) (data->mouse_face));
((markobj) (data->initial_redisplay_function));
+ ((markobj) (data->before_change_functions));
+ ((markobj) (data->after_change_functions));
return data->parent;
}
＠＠ -3156,6 +3158,8 ＠＠
|| 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)
＠＠ -4602,6 +4606,105 ＠＠
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;
+};
+
+/* 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;
+}
+
+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. */
+ 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.
+ <sigh> */
+
+ if (!CONSP (hook) || EQ (XCAR (hook), Qlambda))
+ call3 (hook, exobj, startobj, endobj);
+ else
+ {
+ Lisp_Object tail;
+ EXTERNAL_LIST_LOOP (tail, hook)
+ call3 (XCAR (tail), exobj, startobj, endobj);
+ }
+ return 0;
+}
+
+void
+report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end,
+ int *inside, int afterp)
+{
+ struct report_extent_modification_closure closure;
+
+ closure.buffer = buffer;
+ closure.start = start;
+ closure.end = 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);
+ }
+}
+
/************************************************************************/
/* extent properties */
＠＠ -5201,6 +5304,10 ＠＠
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: */
＠＠ -5306,6 +5413,10 ＠＠
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 +5493,14 ＠＠
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);
＠＠ -6723,6 +6842,8 ＠＠
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
--
Hrvoje Niksic <hniksic(a)srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
Mix 2 table spoons sugar with 1 spoon salt. Put it in a bottle and
stick a fuse into it. Say "Shit!" when it doesn't detonate.
