bug#5397: 23.1; Lack of point-motion property for overlays and text properties[PATCH]

[flat0103]

This patch introduces a 'point-motion property for overlays and text properties.
This property is a function that is run whenever the point enters or leaves that
text property/overlay.  As currently implemented, the function is also run on
point motion; there was some discussion about this.  For the full discussion of
this, see:  

http://lists.gnu.org/archive/html/emacs-devel/2009-09/msg00244.html
or:
http://lists.gnu.org/archive/cgi-bin/namazu.cgi?query=Overalays+and+point-entered&submit=Search!&idxname=emacs-devel&max=20&result=normal&sort=score&whence=20
as it looks like the thread linked above has messages missing.

PATCH:

===File /home/nflath/Downloads/point-motion.patch===========
Index: buffer.c
===================================================================
RCS file: /sources/emacs/emacs/src/buffer.c,v
retrieving revision 1.591
diff -u -r1.591 buffer.c
--- buffer.c    21 Nov 2009 11:52:26 -0000      1.591
+++ buffer.c    20 Dec 2009 23:36:42 -0000
@@ -396,7 +396,8 @@
   b->width_run_cache = 0;
   b->width_table = Qnil;
   b->prevent_redisplay_optimizations_p = 1;
-
+  b->prev_text_prop = Qnil;
+  b->overlay_prev = Qnil;
   /* Put this on the chain of all buffers including killed ones.  */
   b->next = all_buffers;
   all_buffers = b;
Index: buffer.h
===================================================================
RCS file: /sources/emacs/emacs/src/buffer.h,v
retrieving revision 1.130
diff -u -r1.130 buffer.h
--- buffer.h    21 Nov 2009 11:52:26 -0000      1.130
+++ buffer.h    20 Dec 2009 23:36:42 -0000
@@ -796,6 +796,13 @@
      t means to use hollow box cursor.
      See `cursor-type' for other values.  */
   Lisp_Object cursor_in_non_selected_windows;
+
+  /* Text property containing point-motion */
+  Lisp_Object prev_text_prop;
+
+  /* Overlay containing point-motion */
+  Lisp_Object overlay_prev;
+
 };

 
Index: editfns.c
===================================================================
RCS file: /sources/emacs/emacs/src/editfns.c,v
retrieving revision 1.476
diff -u -r1.476 editfns.c
--- editfns.c   21 Nov 2009 11:52:27 -0000      1.476
+++ editfns.c   20 Dec 2009 23:36:42 -0000
@@ -500,6 +500,48 @@
     }
 }

+/* Returns an array of overlays that are active at the indication position and 
buffer.
+   The lenght of the array will be stored in num_overlays. */
+
+Lisp_Object*
+get_overlays_at_pos (position, buffer, num_overlays )
+     Lisp_Object position, buffer;
+     int* num_overlays;
+{
+  CHECK_NUMBER_COERCE_MARKER (position);
+
+  if (NILP (buffer))
+    XSETBUFFER (buffer, current_buffer);
+
+  int posn = XINT (position);
+  int i, noverlays;
+  Lisp_Object* overlay_vec;
+  struct buffer *obuf = current_buffer;
+  set_buffer_temp (XBUFFER (buffer));
+
+  noverlays = overlays_around (posn, overlay_vec, 0);
+  overlay_vec = xmalloc (sizeof(Lisp_Object) * noverlays);
+  noverlays = overlays_around (posn, overlay_vec, noverlays);
+  noverlays = sort_overlays (overlay_vec, noverlays, NULL);
+
+  set_buffer_temp (obuf);
+  for (i = 0; i < noverlays; i++)
+    {
+      Lisp_Object ol = overlay_vec[i];
+      Lisp_Object start = OVERLAY_START (ol), finish = OVERLAY_END (ol);
+      if ((OVERLAY_POSITION (start) == posn
+           && XMARKER (start)->insertion_type == 1)
+          || (OVERLAY_POSITION (finish) == posn
+              && XMARKER (finish)->insertion_type == 0))
+        {
+          overlay_vec[i] = overlay_vec[noverlays];
+          noverlays--; i--;
+        }
+    }
+  *num_overlays = noverlays;
+  return overlay_vec;
+}
+
 /* Find the field surrounding POS in *BEG and *END.  If POS is nil,
    the value of point is used instead.  If BEG or END is null,
    means don't store the beginning or end of the field.
Index: keyboard.c
===================================================================
RCS file: /sources/emacs/emacs/src/keyboard.c,v
retrieving revision 1.1024
diff -u -r1.1024 keyboard.c
--- keyboard.c  17 Nov 2009 08:21:35 -0000      1.1024
+++ keyboard.c  20 Dec 2009 23:36:44 -0000
@@ -1522,6 +1522,8 @@

 extern int nonundocount;       /* Declared in cmds.c.  */

+void run_point_motion_hooks();
+
 Lisp_Object
 command_loop_1 ()
 {
@@ -1980,6 +1982,9 @@
          && !already_adjusted)
        adjust_point_for_property (last_point_position, MODIFF != prev_modiff);

+      if (NILP (Vinhibit_point_motion_hooks))
+        run_point_motion_hooks (prev_buffer);
+
       /* Install chars successfully executed in kbd macro.  */

       if (!NILP (current_kboard->defining_kbd_macro)
@@ -1992,6 +1997,154 @@
     }
 }

+/*  Runs 'point-motion hooks on text properties and overlays. */
+void
+run_point_motion_hooks (prev_c_buffer)
+     struct buffer* prev_c_buffer;
+{
+  extern Lisp_Object Qpoint_motion, Qwindow, Qpriority;
+
+  static Lisp_Object prev_window;
+  static Lisp_Object prev_buffer;
+  static struct window* prev_c_window;
+
+  int i, j, noverlays_cur;
+  Lisp_Object point_motion, overlay_window;
+  struct window* current_window = XWINDOW (Fselected_window());
+  int run_overlay, run_text_prop;
+  Lisp_Object text_properties[5];
+  Lisp_Object overlays[5];
+
+  Lisp_Object *overlay_cur_vec;
+  Lisp_Object current_overlay;
+
+  /* Retrieves vector of overlays in current location and uses this to
+     find the 'current' overlay to run */
+  overlay_cur_vec = get_overlays_at_pos (make_number (current_buffer->pt),
+                                         current_buffer,
+                                         &noverlays_cur);
+  current_overlay = Qnil;
+  for (i = 0; i < noverlays_cur; i++)
+    {
+      Lisp_Object pm = Foverlay_get (overlay_cur_vec[i], Qpoint_motion);
+      if (!NILP (pm)) {
+        if (NILP (current_overlay))
+          {
+            current_overlay = overlay_cur_vec[i];
+            continue;
+          }
+        Lisp_Object cur_priority = Foverlay_get (current_overlay, Qpriority);
+        Lisp_Object tmp_priority = Foverlay_get (overlay_cur_vec[i], 
Qpriority);
+        if ( NILP (cur_priority)
+            || (!NILP (tmp_priority)
+                && XINT (cur_priority) < XINT (tmp_priority)))
+              {
+                current_overlay = overlay_cur_vec[i];
+              }
+        }
+    }
+
+  /* Runs the 'point-motion property for unique overlays */
+  if (NILP (Feq (Fcurrent_buffer(), prev_buffer))
+      || NILP (Feq (Fselected_window(), prev_window))
+      || NILP (Feq (current_overlay, prev_c_buffer->overlay_prev)))
+    {
+      overlays[0] = current_overlay;
+      overlays[1] = current_buffer->overlay_prev;
+      overlays[2] = current_window->overlay_prev;
+      overlays[3] = Qnil;
+      overlays[4] = Qnil;
+      if (prev_c_buffer)
+        overlays[3] = prev_c_buffer->overlay_prev;
+      if (prev_c_window)
+        overlays[4] = prev_c_window->overlay_prev;
+
+      for (i = 0; i < 5; i++)
+        {
+          run_overlay = 1;
+          if (NILP (overlays[i])) continue;
+          for (j = 0; j < i; j++)
+            {
+              if (!NILP (Feq (overlays[i], overlays[j]))) {
+                run_overlay = 0;
+                break;
+              }
+            }
+          if (run_overlay)
+            {
+              point_motion = Foverlay_get (overlays[i], Qpoint_motion);
+              overlay_window = Foverlay_get (overlays[i], Qwindow);
+              if (!NILP (point_motion)
+                  && (NILP (overlay_window)
+                      || !NILP (Feq (overlay_window, Fselected_window()))))
+                {
+                  call5 (point_motion,
+                         make_number (last_point_position),
+                         make_number (current_buffer->pt),
+                         overlays[i],
+                         prev_buffer,
+                         prev_window);
+                }
+            }
+        }
+    }
+
+  /* Get text properties to run */
+  text_properties[0] = Fget_text_property (make_number (current_buffer->pt),
+                                           Qpoint_motion,
+                                           Qnil);
+  text_properties[1] = current_buffer->prev_text_prop;
+  text_properties[2] = current_window->prev_text_prop;
+  text_properties[3] = Qnil;
+  text_properties[4] = Qnil;
+  if (prev_c_buffer) {
+    text_properties[3] = prev_c_buffer->prev_text_prop;
+  }
+  if (prev_c_window) {
+    text_properties[4] = prev_c_window->prev_text_prop;
+  }
+
+  /* Runs point-motion of text properties */
+  if (NILP (Feq (Fcurrent_buffer(), prev_buffer))
+      || NILP (Feq (Fselected_window(), prev_window))
+      || NILP (Feq (text_properties[0], prev_c_buffer->prev_text_prop)))
+    {
+      for (i = 0; i < 5; i++)
+        {
+          run_text_prop = 1;
+          for (j = 0; j < i; j++)
+            {
+              if (!NILP (Feq (text_properties[i], text_properties[j])))
+                {
+                  run_text_prop = 0;
+                  break;
+                }
+            }
+          if (run_text_prop == 1 && !NILP (text_properties[i]))
+            {
+              call5 (text_properties[i],
+                     make_number (last_point_position),
+                     make_number (current_buffer->pt),
+                     text_properties[i],
+                     prev_buffer,
+                     prev_window );
+            }
+        }
+    }
+
+  /* Sets previous overlays and text properties */
+  current_buffer->overlay_prev = current_overlay;
+  current_window->overlay_prev = current_overlay;
+
+  current_buffer->prev_text_prop = text_properties[0];
+  current_window->prev_text_prop = text_properties[0];
+
+  prev_window = Fselected_window();
+  prev_c_window = XWINDOW (Fselected_window());
+  prev_buffer = Fcurrent_buffer();
+}
+
 extern Lisp_Object Qcomposition, Qdisplay;

 /* Adjust point to a boundary of a region that has such a property
Index: textprop.c
===================================================================
RCS file: /sources/emacs/emacs/src/textprop.c,v
retrieving revision 1.167
diff -u -r1.167 textprop.c
--- textprop.c  6 Nov 2009 06:50:59 -0000       1.167
+++ textprop.c  20 Dec 2009 23:36:44 -0000
@@ -54,6 +54,7 @@
 Lisp_Object Qpoint_entered;
 Lisp_Object Qcategory;
 Lisp_Object Qlocal_map;
+Lisp_Object Qpoint_motion;

 /* Visual properties text (including strings) may have.  */
 Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple;
@@ -2349,6 +2350,8 @@
   Qpoint_left = intern_c_string ("point-left");
   staticpro (&Qpoint_entered);
   Qpoint_entered = intern_c_string ("point-entered");
+  staticpro (&Qpoint_motion);
+  Qpoint_motion = intern_c_string("point-motion");

   defsubr (&Stext_properties_at);
   defsubr (&Sget_text_property);
Index: window.c
===================================================================
RCS file: /sources/emacs/emacs/src/window.c,v
retrieving revision 1.644
diff -u -r1.644 window.c
--- window.c    6 Nov 2009 06:50:59 -0000       1.644
+++ window.c    20 Dec 2009 23:36:45 -0000
@@ -267,7 +267,8 @@
   p->scroll_bar_width = Qnil;
   p->vertical_scroll_bar_type = Qt;
   p->resize_proportionally = Qnil;
+  p->prev_text_prop = Qnil;
+  p->overlay_prev = Qnil;
+
   Vwindow_list = Qnil;
   return val;
 }
Index: window.h
===================================================================
RCS file: /sources/emacs/emacs/src/window.h,v
retrieving revision 1.81
diff -u -r1.81 window.h
--- window.h    8 Jan 2009 03:16:09 -0000       1.81
+++ window.h    20 Dec 2009 23:36:45 -0000
@@ -292,6 +292,12 @@
     /* Z_BYTE - the buffer position of the last glyph in the current matrix
        of W.  Only valid if WINDOW_END_VALID is not nil.  */
     int window_end_bytepos;
+
+    /* Last overlay run containing point-motion */
+    Lisp_Object overlay_prev;
+
+    /* Text property containing point-motion */
+    Lisp_Object prev_text_prop;
 };

 /* 1 if W is a minibuffer window.  */
============================================================