From xemacs-m  Thu Aug 21 08:58:32 1997
Received: from frege.math.ethz.ch (root@frege-d-math-north-g-west.math.ethz.ch [129.132.145.3])
	by xemacs.org (8.8.5/8.8.5) with SMTP id IAA07887
	for <xemacs-beta@xemacs.org>; Thu, 21 Aug 1997 08:58:31 -0500 (CDT)
Received: from midget (vroonhof@midget [129.132.145.4]) by frege.math.ethz.ch (8.6.12/Main-STAT-mailer) with ESMTP id PAA08959 for <xemacs-beta@xemacs.org>; Thu, 21 Aug 1997 15:58:28 +0200
Received: (vroonhof@localhost) by midget (SMI-8.6/D-MATH-client) id PAA20094; Thu, 21 Aug 1997 15:58:27 +0200
To: xemacs-beta@xemacs.org
Subject: A prototype solution for true demand locking..
Mime-Version: 1.0 (generated by tm-edit 7.106)
Content-Type: multipart/mixed;
 boundary="Multipart_Thu_Aug_21_15:58:27_1997-1"
Content-Transfer-Encoding: 7bit
From: Jan Vroonhof <vroonhof@math.ethz.ch>
Date: 21 Aug 1997 15:58:27 +0200
Message-ID: <by90xvocxo.fsf@midget.math.ethz.ch>
Lines: 332
X-Mailer: Gnus v5.4.55/XEmacs 19.15

--Multipart_Thu_Aug_21_15:58:27_1997-1
Content-Type: text/plain; charset=US-ASCII


In attempt to bury once and for always the lazy-lock in
post-bla-bla-hook or post-bla-bla-bla-hook debate. I propose the
following. Instead of having font-lock guess whether a region might
get displayed we have XEmacs tell font lock.

I used some time of work to put together this prototype patch. Much to
my surprice it works already quite well. I guess it is another
illustration of how well the internals of XEmacs are designed. All
comments are appreciated.

First a small file to test the new feature. Try using find-timid-file
on a few large text files and then jumping around the new buffer.

Also try make-sneaky-extent.



--Multipart_Thu_Aug_21_15:58:27_1997-1
Content-Type: application/octet-stream; type=emacs-lisp
Content-Disposition: attachment; filename="blue.el"
Content-Transfer-Encoding: 7bit

;
; Some function to test the one-shot-function extent property
;
(defun aargh-you-got-me (extent)
  (prin1 "You hit on : ")
  (prin1 extent))

(defun make-sneaky-extent (spos epos &optional buffer)
  "Make an extent that will complain if it gets displayed"
     (let ((extent (make-extent spos epos buffer)))
       (when extent 
         (set-extent-one-shot-function extent
                       'aargh-you-got-me))
       extent))

(copy-face 'default 'blue-blue)
(copy-face 'default 'blue-red)
(set-face-foreground 'blue-blue "DeepSkyBlue")
(set-face-foreground 'blue-red "red")


(defun blue-shame (extent)
  "Make the extent turn red"
  (set-extent-face extent 'blue-red))

(defun make-timid-blue-extent (spos epos &optional buffer)
  "Make a blue extent that will change color if it is displayed"
     (let ((extent (make-extent spos epos buffer)))
       (when extent
	 (set-extent-face extent 'blue-blue)
         (set-extent-one-shot-function extent
                       'blue-shame))
       extent))

(defvar find-timid-step-size 100
  "Make timid extents of this size")

(defun find-timid-file (file)
   "Find a file and color it timidly blue."
  (interactive "ftimid file:")
  (let ((buffer (find-file-noselect file))
         start)
      (setq start  (point-min buffer))   
      (while (< start (point-max buffer))
         (make-timid-blue-extent start
           (min (point-max buffer) (+ start find-timid-step-size)) buffer)
         (setq start (+ start find-timid-step-size)))))


        



--Multipart_Thu_Aug_21_15:58:27_1997-1
Content-Type: text/plain; charset=US-ASCII


Here is the patch. Changelog entry included


--Multipart_Thu_Aug_21_15:58:27_1997-1
Content-Type: application/octet-stream
Content-Disposition: attachment; filename="oneshot.pat"
Content-Transfer-Encoding: 7bit

This patch is against 20.3-b14

Index: src/ChangeLog
===================================================================
RCS file: /home/cvs/root/xemacs/src/ChangeLog,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -r1.1.1.1 -r1.2
--- ChangeLog	1997/08/07 19:02:25	1.1.1.1
+++ ChangeLog	1997/08/21 11:21:57	1.2
@@ -1,3 +1,13 @@
+1997-08-21  Jan Vroonhof  <vroonhof@math.ethz.ch>
+
+	* extents.c (extent_fragment_update): Trigger one_shot_function
+
+	* extents.c (set-extent-one-shot-function): New function
+
+	* extents.h (struct extent_auxiliary): Added one_shot_function
+
+	* extens.c: Added  one_shot_function to assesor functions.
+
 1997-07-10  Hrvoje Niksic  <hniksic@srce.hr>
 
 	* fileio.c (Finsert_file_contents_internal): Handle non-regular
Index: src/extents.c
===================================================================
RCS file: /home/cvs/root/xemacs/src/extents.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -r1.1.1.1 -r1.2
--- extents.c	1997/08/07 19:02:28	1.1.1.1
+++ extents.c	1997/08/21 11:22:00	1.2
@@ -448,6 +448,7 @@
 Lisp_Object Qdetachable;
 Lisp_Object Qpriority;
 Lisp_Object Qmouse_face;
+Lisp_Object Qone_shot_function;
 
 Lisp_Object Qglyph_layout;  /* This exists only for backwards compatibility. */
 Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout;
@@ -936,6 +937,7 @@
   ((markobj) (data->children));
   ((markobj) (data->read_only));
   ((markobj) (data->mouse_face));
+  ((markobj) (data->one_shot_function));
   return data->parent;
 }
 
@@ -1649,7 +1651,8 @@
   EXTENT anc = extent_ancestor (extent);
   if (!NILP (extent_face (anc)) || !NILP (extent_begin_glyph (anc)) ||
       !NILP (extent_end_glyph (anc)) || !NILP (extent_mouse_face (anc)) ||
-      !NILP (extent_invisible (anc)) || invisibility_change)
+      !NILP (extent_invisible (anc)) || invisibility_change ||
+      !NILP (extent_one_shot_function (anc)))
     extent_changed_for_redisplay (extent, descendants_too,
 				  invisibility_change);
 }
@@ -2886,6 +2889,28 @@
 	      extent_face (&dummy_lhe_extent) = extent_mouse_face (lhe);
 	      Dynarr_add (ef->extents, &dummy_lhe_extent);
 	    }
+	  /* since we are looping anyway, we might as well do this here */
+	  if (!NILP(extent_one_shot_function (e)))
+	    {
+	      Lisp_Object function = extent_one_shot_function (e);
+	      Lisp_Object obj;
+
+	      /* printf("One shot function called!\n "); */
+	      
+	      /* print_extent_2(e);
+	         printf("\n"); */
+	      
+	      /* Do NOT use the set function here because that sets the
+		 redisplay flag.
+		 FIXME: One should probably inhibit the displaying of
+		 this extent to reduce flicker */
+	      set_extent_one_shot_function (e,Qnil); /* one shot */
+	      
+	      /* call the function */
+	      XSETEXTENT(obj,e);
+	      if(!NILP(function))
+	         Fenqueue_eval_event(function,obj);
+	    }
 	}
     }
 
@@ -4751,10 +4776,32 @@
   return value;
 }
 
+/* Do we need a lisp-level function ? */
+DEFUN ("set-extent-one-shot-function", Fset_extent_one_shot_function, 
+       2,2,0,/* 
+Set one-shot-function of EXTENT to the function
+FUNCTION. This function will be called with EXTENT as its only
+argument shortly after (part of) the extent has been under
+consideration for display. The property is then cleared. 
+*/
+       (extent, function))     
+{
+  EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
+
+  e = extent_ancestor (e);  /* Is this needed? Macro also does chasing!*/
+  set_extent_one_shot_function(e,function);
+  extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/
+  
+  return function;
+}
+  
+
+  
+
 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
 Return the name of the face in which EXTENT is displayed, or nil
 if the extent's face is unspecified.  This might also return a list
-of face names.
+of face names. 
 */
        (extent))
 {
@@ -5048,6 +5095,10 @@
 
  read-only          Text within this extent will be unmodifiable.
 
+ one-shot-function  function to be called the first time (part of) the extent
+                    is redisplayed. It will be called with the extent as its
+                    first argument.  
+
  detachable         Whether the extent gets detached (as with
                     `detach-extent') when all the text within the
                     extent is deleted.  This is true by default.  If
@@ -5179,6 +5230,8 @@
     Fset_extent_priority (extent, value);
   else if (EQ (property, Qface))
     Fset_extent_face (extent, value);
+  else if (EQ (property, Qone_shot_function))
+    Fset_extent_one_shot_function (extent, value);
   else if (EQ (property, Qmouse_face))
     Fset_extent_mouse_face (extent, value);
   /* Obsolete: */
@@ -5257,6 +5310,8 @@
     return extent_invisible (e);
   else if (EQ (property, Qface))
     return Fextent_face (extent);
+  else if (EQ (property, Qone_shot_function))
+    return extent_one_shot_function (e);
   else if (EQ (property, Qmouse_face))
     return Fextent_mouse_face (extent);
   /* Obsolete: */
@@ -5334,6 +5389,9 @@
     result = Fcons (Qpriority, Fcons (make_int (extent_priority (anc)),
 				      result));
 
+  if (!NILP (extent_one_shot_function (anc)))
+    result = Fcons (Qone_shot_function, Fcons (extent_one_shot_function (anc), result));
+
   if (!NILP (extent_invisible (anc)))
     result = Fcons (Qinvisible, Fcons (extent_invisible (anc), result));
 
@@ -6546,7 +6604,7 @@
   defsymbol (&Qduplicable, "duplicable");
   defsymbol (&Qdetachable, "detachable");
   defsymbol (&Qpriority, "priority");
-  defsymbol (&Qmouse_face, "mouse-face");
+  defsymbol (&Qone_shot_function,"one-shot-function");
 
   defsymbol (&Qglyph_layout, "glyph-layout");	/* backwards compatibility */
   defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
@@ -6599,6 +6657,7 @@
   DEFSUBR (Fmap_extent_children);
   DEFSUBR (Fextent_at);
 
+  DEFSUBR (Fset_extent_one_shot_function);
   DEFSUBR (Fextent_face);
   DEFSUBR (Fset_extent_face);
   DEFSUBR (Fextent_mouse_face);
@@ -6672,6 +6731,7 @@
   extent_auxiliary_defaults.invisible = Qnil;
   extent_auxiliary_defaults.read_only = Qnil;
   extent_auxiliary_defaults.mouse_face = Qnil;
+  extent_auxiliary_defaults.one_shot_function = Qnil;
 }
 
 void
Index: src/extents.h
===================================================================
RCS file: /home/cvs/root/xemacs/src/extents.h,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -r1.1.1.1 -r1.2
--- extents.h	1997/08/07 19:02:28	1.1.1.1
+++ extents.h	1997/08/21 11:22:01	1.2
@@ -79,7 +79,7 @@
 				      /* 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 unused15	: 1;  /* 15  unused			     */
+      unsigned int unused15  	: 1;  /* 15  unused                          */
       unsigned int unused16	: 1;  /* 16  unused			     */
       /* --- Adding more flags will cause the extent struct grow by another
 	 word.  It's not clear that this would make a difference, however,
@@ -133,6 +133,7 @@
   Lisp_Object invisible;
   Lisp_Object read_only;
   Lisp_Object mouse_face;
+  Lisp_Object one_shot_function;
 #ifdef ENERGIZE
   Energize_Extent_Data *energize_data;
 #endif
@@ -255,6 +256,7 @@
 #define extent_invisible(e)	extent_aux_field (e, invisible)
 #define extent_read_only(e)	extent_aux_field (e, read_only)
 #define extent_mouse_face(e)	extent_aux_field (e, mouse_face)
+#define extent_one_shot_function(e)	extent_aux_field (e, one_shot_function)
 #ifdef ENERGIZE
 #define extent_energize_data(e)	extent_aux_field (e, energize_data)
 #endif
@@ -271,6 +273,9 @@
   set_extent_aux_field (e, read_only, value)
 #define set_extent_mouse_face(e, value)					\
   set_extent_aux_field (e, mouse_face, value)
+/* Use Fset_extent_one_shot_function unless you know what you are ding */
+#define set_extent_one_shot_function(e, value)			         \
+  set_extent_aux_field (e, one_shot_function, value)
 #ifdef ENERGIZE
 #define set_extent_energize_data(e, value)				\
   set_extent_aux_field (e, energize_data, value)

--Multipart_Thu_Aug_21_15:58:27_1997-1
Content-Type: text/plain; charset=US-ASCII



Now we need a volunteer to port lazy lock to it....


Jan


--Multipart_Thu_Aug_21_15:58:27_1997-1--

