xemacs-beta: src/extents.c comparison

comparison src/extents.c @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14

author	cvs
date	Mon, 13 Aug 2007 11:20:41 +0200
parents	b8cc9ab3f761
children	41dbb7a9d5f2

comparison

equal deleted inserted replaced

-:12e008d41344
+:697ef44129c6
 #include "insdel.h"
 #include "keymap.h"
 #include "opaque.h"
 #include "process.h"
 #include "redisplay.h"
-#include "gutter.h"
 /* ------------------------------- */
 /*            gap array            */
 /* ------------------------------- */
 int numels;
 int elsize;
 Gap_Array_Marker *markers;
 } Gap_Array;
-static Gap_Array_Marker *gap_array_marker_freelist;
+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
 positions" are only used internally and are of type Memind.
 "Array positions" are used externally and are of type int. */
 Gap_Array *start;
 Gap_Array *end;
 Extent_List_Marker *markers;
 } Extent_List;
-static Extent_List_Marker *extent_list_marker_freelist;
+Extent_List_Marker *extent_list_marker_freelist;
 #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \
 				   ((extent_start (e) == (st)) && \
 				    (extent_end (e) > (nd))))
 Lisp_Object Qoutside_margin;
 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;
 /* The idea here is that if we're given a list of faces, we
 need to "memoize" this so that two lists of faces that are `equal'
 Lisp_Object Vextent_face_reverse_memoize_hash_table;
 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                          */
 /************************************************************************/
 static Extent_List *
 allocate_extent_list (void)
 {
 Extent_List *el = xnew (Extent_List);
-el->start = make_gap_array (sizeof (EXTENT));
+el->start = make_gap_array (sizeof(EXTENT));
-el->end = make_gap_array (sizeof (EXTENT));
+el->end = make_gap_array (sizeof(EXTENT));
 el->markers = 0;
 return el;
 }
 static void
 /************************************************************************/
 /*                       Auxiliary extent structure                     */
 /************************************************************************/
 static Lisp_Object
-mark_extent_auxiliary (Lisp_Object obj)
+mark_extent_auxiliary (Lisp_Object obj, void (*markobj) (Lisp_Object))
 {
 struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj);
-mark_object (data->begin_glyph);
+markobj (data->begin_glyph);
-mark_object (data->end_glyph);
+markobj (data->end_glyph);
-mark_object (data->invisible);
+markobj (data->invisible);
-mark_object (data->children);
+markobj (data->children);
-mark_object (data->read_only);
+markobj (data->read_only);
-mark_object (data->mouse_face);
+markobj (data->mouse_face);
-mark_object (data->initial_redisplay_function);
+markobj (data->initial_redisplay_function);
-mark_object (data->before_change_functions);
+markobj (data->before_change_functions);
-mark_object (data->after_change_functions);
+markobj (data->after_change_functions);
 return data->parent;
 }
 DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary,
 mark_extent_auxiliary, internal_object_printer,
-			       0, 0, 0, 0, struct extent_auxiliary);
+			       0, 0, 0, struct extent_auxiliary);
 void
 allocate_extent_auxiliary (EXTENT ext)
 {
 Lisp_Object extent_aux;
 static struct stack_of_extents *allocate_soe (void);
 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)
+mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object))
 {
 struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj);
 int i;
 Extent_List *list = data->extents;
 	{
 	  struct extent *extent = extent_list_at (list, i, 0);
 	  Lisp_Object exobj;
 	  XSETEXTENT (exobj, extent);
-	  mark_object (exobj);
+	  markobj (exobj);
 	}
 }
 return Qnil;
 }
 }
 }
 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
 mark_extent_info, internal_object_printer,
-			       finalize_extent_info, 0, 0, 0,
+			       finalize_extent_info, 0, 0,
 			       struct extent_info);
 static Lisp_Object
 allocate_extent_info (void)
 {
 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);
 }
 }
 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);
 }
 }
 /* now mark the extent itself. */
 object = extent_object (extent);
-if (extent_detached_p (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. */
 return;
-else if (STRINGP (object))
+{
-{
+struct buffer *b;
-/* #### Changes to string extents can affect redisplay if they are
+b = XBUFFER (object);
-in the modeline or in the gutters.
+BUF_FACECHANGE (b)++;
+MARK_EXTENTS_CHANGED;
-If the extent is in some generated-modeline-string: when we
+if (invisibility_change)
-change an extent in generated-modeline-string, this changes its
+MARK_CLIP_CHANGED;
-parent, which is in `modeline-format', so we should force the
+buffer_extent_signal_changed_region (b,
-modeline to be updated.  But how to determine whether a string
+					 extent_endpoint_bufpos (extent, 0),
-is a `generated-modeline-string'?  Looping through all buffers
+					 extent_endpoint_bufpos (extent, 1));
-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.
 This is called when properties such as the endpoints, the layout,
 or the priority changes.  Redisplay will be affected only if
 Dynarr_free (ef->begin_glyphs);
 Dynarr_free (ef->end_glyphs);
 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 foo = * (CONST EXTENT *) humpty;
-const EXTENT bar = * (const EXTENT *) dumpty;
+CONST EXTENT bar = * (CONST EXTENT *) dumpty;
 if (extent_priority (foo) < extent_priority (bar))
 return -1;
 return extent_priority (foo) > extent_priority (bar);
 }
 /* These are the basic helper functions for handling the allocation of
 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)
+mark_extent (Lisp_Object obj, void (*markobj) (Lisp_Object))
 {
 struct extent *extent = XEXTENT (obj);
-mark_object (extent_object (extent));
+markobj (extent_object (extent));
-mark_object (extent_no_chase_normal_field (extent, face));
+markobj (extent_no_chase_normal_field (extent, face));
 return extent->plist;
 }
 static void
 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
 *bp++ = (extent_start_open_p (anc) ? '(': '[');
 if (extent_detached_p (ext))
 strcpy (bp, "detached");
 else
-sprintf (bp, "%ld, %ld",
+{
-	     (long) XINT (Fextent_start_position (obj)),
+Bufpos from = XINT (Fextent_start_position (obj));
-	     (long) XINT (Fextent_end_position (obj)));
+Bufpos to = XINT (Fextent_end_position (obj));
+sprintf (bp, "%d, %d", from, to);
+}
 bp += strlen (bp);
 *bp++ = (extent_end_open_p (anc) ? ')': ']');
 if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
 *bp++ = ' ';
 static void
 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
 if (escapeflag)
 {
-const char *title = "";
+CONST char *title = "";
-const char *name = "";
+CONST char *name = "";
-const char *posttitle = "";
+CONST char *posttitle = "";
 Lisp_Object obj2 = Qnil;
 /* Destroyed extents have 't' in the object field, causing
 	 extent_object() to abort (maybe). */
 if (EXTENT_LIVE_P (XEXTENT (obj)))
 /* No need to hash all of the elements; that would take too long.
 Just hash the most common ones. */
 return HASH3 (extent_start (e), extent_end (e),
 		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 Fextent_property (obj, prop, Qunbound);
 {
 /* #### Is this correct, anyway?  */
 return -1;
 }
-return external_remprop (extent_plist_addr (ext), prop, 0, ERROR_ME);
+return external_remprop (&ext->plist, prop, 0, ERROR_ME);
 }
 static Lisp_Object
 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				*/
 /************************************************************************/
 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;
 }
 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.
+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 ();
 record_unwind_protect (report_extent_modification_restore,
 			     Fcurrent_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>
+<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);
 else
 {
 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 afterp)
+			    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				*/
 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, 0);
+EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER);
 glyph_layout layout = symbol_to_glyph_layout (layout_obj);
 /* 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))
 /************************************************************************/
 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 (&Qall_extents_closed, "all-extents-closed");
 defsymbol (&Qall_extents_open, "all-extents-open");
 defsymbol (&Qend_glyph_layout, "end-glyph-layout");
 defsymbol (&Qoutside_margin, "outside-margin");
 defsymbol (&Qinside_margin, "inside-margin");
 defsymbol (&Qwhitespace, "whitespace");
 /* Qtext defined in general.c */
+defsymbol (&Qglyph_invisible, "glyph-invisible");
 defsymbol (&Qpaste_function, "paste-function");
 defsymbol (&Qcopy_function,  "copy-function");
 defsymbol (&Qtext_prop, "text-prop");
 DEFSUBR (Fnext_single_property_change);
 DEFSUBR (Fprevious_single_property_change);
 }
 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.
 See `set-extent-priority'.
 */ );
 staticpro (&Vlast_highlighted_extent);
 Vlast_highlighted_extent = Qnil;
 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)
 {

Mercurial > hg > xemacs-beta

comparison src/extents.c @ 412:697ef44129c6 r21-2-14