Experimental implementation of extent modification hooks

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&gt; * 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&gt; | 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.