From xemacs-m  Thu Sep 11 06:10:51 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 GAA06770
	for <xemacs-beta@xemacs.org>; Thu, 11 Sep 1997 06:10:50 -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 NAA26487 for <xemacs-beta@xemacs.org>; Thu, 11 Sep 1997 13:10:43 +0200
Received: (vroonhof@localhost) by midget (SMI-8.6/D-MATH-client) id NAA24454; Thu, 11 Sep 1997 13:10:43 +0200
To: xemacs-beta@xemacs.org
Subject: Shot-locking...
Mime-Version: 1.0 (generated by tm-edit 7.106)
Content-Type: multipart/mixed;
 boundary="Multipart_Thu_Sep_11_13:10:42_1997-1"
Content-Transfer-Encoding: 7bit
From: Jan Vroonhof <vroonhof@math.ethz.ch>
Date: 11 Sep 1997 13:10:42 +0200
Message-ID: <byoh60hzrh.fsf@midget.math.ethz.ch>
Lines: 323
X-Mailer: Gnus v5.4.55/XEmacs 19.15

--Multipart_Thu_Sep_11_13:10:42_1997-1
Content-Type: text/plain; charset=US-ASCII


I have redone my patch for the one-shot function functionlity against b19.

This time I include a lazy-lock implementation based on this version
(loosy based on lazy-lock v2) to demonstrate how easy it it. Please
play with this. I am particulary interested to see whether it is worth
it to change the redisplay to get rid of the flashing and what the
best block size is. If anybody wants to work on porting the other
lazy-lock features (idle timers etc) be my guest.

Here is all of lazy-shot.el


--Multipart_Thu_Sep_11_13:10:42_1997-1
Content-Type: application/octet-stream; type=emacs-lisp
Content-Disposition: attachment; filename="lazyshot.el"
Content-Transfer-Encoding: 7bit

(require 'font-lock)

(defvar lazy-lock-mode nil)


(defvar lazy-lock-step-size (* 1 1024)) ;; Please test diffent sizes


(defun lazy-lock-mode (&optional arg)
  "Toggle Lazy Lock mode.
With arg, turn Lazy Lock mode on if and only if arg is positive."
  (interactive "P")
  (set (make-local-variable 'lazy-lock-mode)
       (and (if arg (> (prefix-numeric-value arg) 0) (not lazy-lock-mode))))
  (cond ((and lazy-lock-mode (not font-lock-mode))
	 ;; Turned on `lazy-lock-mode' rather than `font-lock-mode'.
	 (let ((font-lock-support-mode 'lazy-lock-mode))
	   (font-lock-mode t)))
	(lazy-lock-mode
	 ;; Turn ourselves on.
	 (lazy-lock-install))
	(t
	 ;; Turn ourselves off.
	 (lazy-lock-unstall))))

;;;###autoload
(defun turn-on-lazy-lock ()
  "Unconditionally turn on Lazy Lock mode."
  (lazy-lock-mode t))


(defun lazy-lock-shot-function (extent)
   "Lazy lock the extent when it has become visisble"
   (let ((start (extent-start-position extent))
         (end   (extent-end-position extent))
	 (buffer (extent-buffer extent))
	 font-lock-f)
     (delete-extent extent)     
     (message "Lazy-shot fontifying from %s to %s in %s" start end buffer)
     (save-excursion
      (save-match-data
       (font-lock-fontify-region start end)))))

(defun lazy-lock-install-extent (spos epos &optional buffer)
  "Make an extent that will lazy-lock if it is displayed"
     (let ((extent (make-extent spos epos buffer)))
       (when extent
         (set-extent-one-shot-function extent
                       'lazy-lock-shot-function))
       extent))

(defun lazy-lock-install-extents (fontifying)
  ;;
  ;; Add hook if lazy-lock.el is deferring or is fontifying on scrolling.
     (when fontifying
     (let ((start  (point-min)))
      (while (< start (point-max))
         (lazy-lock-install-extent start
           (min (point-max) (+ start lazy-lock-step-size)))
         (setq start (+ start lazy-lock-step-size))))))

(defun lazy-lock-install ()
  (make-local-variable 'font-lock-fontified)
  (setq font-lock-fontified t)
  (lazy-lock-install-extents font-lock-fontified))


(provide 'lazy-lock)


--Multipart_Thu_Sep_11_13:10:42_1997-1
Content-Type: text/plain; charset=US-ASCII


And here is the patch again


--Multipart_Thu_Sep_11_13:10:42_1997-1
Content-Type: application/octet-stream
Content-Disposition: attachment; filename="shot.pat"
Content-Transfer-Encoding: 7bit

diff -u orig/ChangeLog ./ChangeLog
--- orig/ChangeLog	Sun Aug 17 05:24:40 1997
+++ ./ChangeLog	Thu Sep  4 21:55:52 1997
@@ -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-08-13  P E Jareth Hein  <jareth@camelot-soft.com>
 
 	* insdel.c (buffer_delete_range): Changed the location where point
diff -u orig/extents.c ./extents.c
--- orig/extents.c	Wed Sep  3 21:19:21 1997
+++ ./extents.c	Thu Sep  4 21:55:52 1997
@@ -446,6 +446,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;
@@ -932,6 +933,7 @@
   ((markobj) (data->children));
   ((markobj) (data->read_only));
   ((markobj) (data->mouse_face));
+  ((markobj) (data->one_shot_function));
   return data->parent;
 }
 
@@ -1645,6 +1647,7 @@
       !NILP (extent_end_glyph   (anc)) ||
       !NILP (extent_mouse_face  (anc)) ||
       !NILP (extent_invisible   (anc)) ||
+      !NILP (extent_one_shot_function (anc)) ||     
       invisibility_change)
     extent_changed_for_redisplay (extent, descendants_too,
 				  invisibility_change);
@@ -2880,6 +2883,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);
+	    }
 	}
     }
 
@@ -4745,10 +4770,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))
 {
@@ -5042,6 +5089,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
@@ -5173,6 +5224,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: */
@@ -5251,6 +5304,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: */
@@ -5328,6 +5383,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));
 
@@ -6541,6 +6599,8 @@
   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");
@@ -6593,6 +6653,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);
@@ -6666,6 +6727,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
diff -u orig/extents.h ./extents.h
--- orig/extents.h	Wed Sep  3 21:19:21 1997
+++ ./extents.h	Thu Sep  4 21:55:52 1997
@@ -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,
@@ -132,6 +132,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
@@ -254,6 +255,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
@@ -270,6 +272,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_Sep_11_13:10:42_1997-1
Content-Type: text/plain; charset=US-ASCII







--Multipart_Thu_Sep_11_13:10:42_1997-1--

