Ensure PG overlays have pg-span property (#98)

1 files changed, 61 insertions, 70 deletions

diff --git a/lib/span.el b/lib/span.el
index 2d18f3c8..f1379616 100644
--- a/lib/span.el
+++ b/lib/span.el
@@ -12,8 +12,7 @@
 ;; Spans are our abstraction of extents/overlays.  Nowadays
 ;; we implement them directly with overlays.
 ;;
-;; In future this module should be used to implement the abstraction
-;; for script buffers (only) more directly.
+;; FIXME: eliminate aliases and directly use overlays
 ;;
 
 ;;; Code:
@@ -23,29 +22,36 @@
 (defalias 'span-end 'overlay-end)
 (defalias 'span-set-property 'overlay-put)
 (defalias 'span-property 'overlay-get)
-(defalias 'span-make 'make-overlay)
+(defun span-make (&rest args)
+  (let ((span (apply #'make-overlay args)))
+    (span-set-property span 'pg-span t)
+    span))
 (defalias 'span-detach 'delete-overlay)
 (defalias 'span-set-endpoints 'move-overlay)
 (defalias 'span-buffer 'overlay-buffer)
 
+(defun span-p (ol)
+  "Check if an overlay belongs to PG."
+  (overlay-get ol 'pg-span))
+
 (defun span-read-only-hook (overlay after start end &optional len)
   (unless inhibit-read-only
     (error "Region is read-only")))
 (add-to-list 'debug-ignored-errors "Region is read-only")
 
-(defsubst span-read-only (span)
+(defun span-read-only (span)
   "Set SPAN to be read only."
   ;; Note: using the standard 'read-only property does not work.
   ;; (overlay-put span 'read-only t))
   (span-set-property span 'modification-hooks '(span-read-only-hook))
   (span-set-property span 'insert-in-front-hooks '(span-read-only-hook)))
 
-(defsubst span-read-write (span)
+(defun span-read-write (span)
   "Set SPAN to be writeable."
   (span-set-property span 'modification-hooks nil)
   (span-set-property span 'insert-in-front-hooks nil))
 
-(defsubst span-write-warning (span fun)
+(defun span-write-warning (span fun)
   "Give a warning message when SPAN is changed, unless `inhibit-read-only' is non-nil."
   (lexical-let ((fun fun))
     (let ((funs (list (lambda (span afterp beg end &rest args)
@@ -56,55 +62,54 @@
 
 ;; We use end first because proof-locked-queue is often changed, and
 ;; its starting point is always 1
-(defsubst span-lt (s u)
+(defun span-lt (s u)
   (or (< (span-end s) (span-end u))
       (and (eq (span-end s) (span-end u))
 	   (< (span-start s) (span-start u)))))
 
-(defsubst spans-at-point-prop (pt prop)
+(defun spans-filter (overlays prop &optional val)
+  "Filter OVERLAYS to those with PROP (optionally matching VAL)."
   (let (ols)
-    (if (null prop) 
-	(overlays-at pt)
-      (dolist (ol (overlays-at pt))
-	(if (overlay-get ol prop) 
-	    (push ol ols)))
-      ols)))
-
-(defsubst spans-at-region-prop (start end prop)
+    (dolist (ol overlays)
+      (when (span-p ol)
+        (let* ((propval (overlay-get ol prop))
+               (keep (if val (eq propval val) propval)))
+          (when keep
+            (push ol ols)))))
+    ols))
+
+(defun spans-at-point-prop (pt prop)
+  (spans-filter (overlays-at pt) prop))
+
+(defun spans-at-region-prop (start end prop)
   "Return a list of the spans in START END with PROP."
-  (let (ols)
-    (if (null prop)
-	(overlays-in start end)
-      (dolist (ol (overlays-in start end))
-	(if (overlay-get ol prop)
-	    (push ol ols)))
-      ols)))
-
-(defsubst span-at (pt prop)
+  (spans-filter (overlays-in start end) prop))
+
+(defun span-at (pt prop)
   "Return some SPAN at point PT with property PROP."
   (car-safe (spans-at-point-prop pt prop)))
 
-(defsubst span-delete (span)
+(defun span-delete (span)
   "Run the 'span-delete-actions and delete SPAN."
   (mapc (lambda (predelfn) (funcall predelfn))
 	(span-property span 'span-delete-actions))
   (delete-overlay span))
 
-(defsubst span-add-delete-action (span action)
+(defun span-add-delete-action (span action)
   "Add ACTION to the list of functions called when SPAN is deleted."
   (span-set-property span 'span-delete-actions
 		     (cons action (span-property span 'span-delete-actions))))
 
 ;; The next two change ordering of list of spans:
-(defsubst span-mapcar-spans (fn start end prop)
+(defun span-mapcar-spans (fn start end prop)
   "Map function FN over spans between START and END with property PROP."
   (mapcar fn (spans-at-region-prop start end prop)))
 
-(defsubst span-mapc-spans (fn start end prop)
+(defun span-mapc-spans (fn start end prop)
   "Apply function FN to spans between START and END with property PROP."
   (mapc fn (spans-at-region-prop start end prop)))
 
-(defsubst span-mapcar-spans-inorder (fn start end prop)
+(defun span-mapcar-spans-inorder (fn start end prop)
   "Map function FN over spans between START and END with property PROP."
   (mapcar fn 
 	  (sort (spans-at-region-prop start end prop)
@@ -114,12 +119,9 @@
   "Return the smallest SPAN at before PT with property PROP.
 A span is before PT if it begins before the character before PT."
   (let ((ols (if (eq (point-min) pt)
-		 nil ;; (overlays-at pt)
-	       (overlays-in (1- pt) pt))))
-    ;; Check the PROP is set.
-    (when prop
-      (dolist (ol (prog1 ols (setq ols nil)))
-	(if (overlay-get ol prop) (push ol ols))))
+                 nil ;; (overlays-at pt)
+               (overlays-in (1- pt) pt))))
+    (setq ols (spans-filter ols prop))
     ;; Eliminate the case of an empty overlay at (1- pt).
     (dolist (ol (prog1 ols (setq ols nil)))
       (if (>= (overlay-end ol) pt) (push ol ols)))
@@ -127,25 +129,25 @@ A span is before PT if it begins before the character before PT."
     ;; something somewhat random but vaguely meaningful.  -Stef
     (car (last (sort ols 'span-lt)))))
 
-(defsubst prev-span (span prop)
+(defun prev-span (span prop)
   "Return span before SPAN with property PROP."
   (span-at-before (span-start span) prop))
 
 ; overlays are [start, end)
 
-(defsubst next-span (span prop)
+(defun next-span (span prop)
   "Return span after SPAN with property PROP."
   ;; Presuming the span-extents.el is the reference, its code does the
   ;; same as the code below.
   (span-at (span-end span) prop))
 
-(defsubst span-live-p (span)
+(defun span-live-p (span)
   "Return non-nil if SPAN is in a live buffer."
   (and span
        (overlay-buffer span)
        (buffer-live-p (overlay-buffer span))))
 
-(defsubst span-raise (span)
+(defun span-raise (span)
   "Set priority of SPAN to make it appear above other spans."
   ;; FIXME: Emacs already uses a "shorter goes above" which takes care of
   ;; preventing a span from seeing another.  So don't play with
@@ -153,54 +155,43 @@ A span is before PT if it begins before the character before PT."
   ;; (span-set-property span 'priority 100)
   )
 
-(defsubst span-string (span)
+(defun span-string (span)
   (with-current-buffer (overlay-buffer span)
     (buffer-substring-no-properties 
      (overlay-start span) (overlay-end span))))
 
-(defsubst set-span-properties (span plist)
+(defun set-span-properties (span plist)
   "Set SPAN's properties from PLIST which is a plist."
   (while plist
     (overlay-put span (car plist) (cadr plist))
     (setq plist (cddr plist))))
 
-(defsubst span-find-span (overlay-list &optional prop)
-  "Return first overlay of OVERLAY-LIST having property PROP (default 'span).
-Return nil if no such overlay belong to the list."
-  (let ((l overlay-list))
-    (while (and l (not (overlay-get (car l) (or prop 'span))))
-      (setq l (cdr l)))
-    (car l)))
-
-(defsubst span-at-event (event &optional prop)
-  "Find a span at position of EVENT, optionally with property PROP."
-  (span-find-span 
-   (overlays-at (posn-point (event-start event))) 
-   prop))
+(defun span-at-event (event &optional prop)
+  "Find a span at position of EVENT, with property PROP (default 'span)."
+  (car (spans-filter
+        (overlays-at (posn-point (event-start event)))
+        (or prop 'span))))
 
 (defun fold-spans (f &optional buffer from to maparg ignored-flags prop val)
   (with-current-buffer (or buffer (current-buffer))
     (let ((ols (overlays-in (or from (point-min)) (or to (point-max))))
-	  res)
+          res)
       ;; Check the PROP.
-      (when prop
-	(dolist (ol (prog1 ols (setq ols nil)))
-	  (if (if val (eq val (overlay-get ol prop)) (overlay-get ol prop))
-	      (push ol ols))))
+      (setq ols (spans-filter ols prop val))
       ;; Iterate in order.
       (setq ols (sort ols 'span-lt))
       (while (and ols (not (setq res (funcall f (pop ols) maparg)))))
       res)))
 
-(defsubst span-detached-p (span)
+(defun span-detached-p (span)
   "Is this SPAN detached? nil for no, t for yes."
   (null (overlay-buffer span)))
 
-(defsubst set-span-face (span face)
+(defun set-span-face (span face)
   "Set the FACE of a SPAN."
   (overlay-put span 'face face))
 
-(defsubst set-span-keymap (span map)
+(defun set-span-keymap (span map)
   "Set the keymap of SPAN to MAP."
   (overlay-put span 'keymap map))
 
@@ -208,19 +199,19 @@ Return nil if no such overlay belong to the list."
 ;; Generic functions built on low-level concrete ones.
 ;;
 
-(defsubst span-delete-spans (start end prop)
+(defun span-delete-spans (start end prop)
   "Delete all spans between START and END with property PROP set."
   (span-mapc-spans 'span-delete start end prop))
 
-(defsubst span-property-safe (span name)
+(defun span-property-safe (span name)
   "Like span-property, but return nil if SPAN is nil."
   (and span (span-property span name)))
 
-(defsubst span-set-start (span value)
+(defun span-set-start (span value)
   "Set the start point of SPAN to VALUE."
   (span-set-endpoints span value (span-end span)))
 
-(defsubst span-set-end (span value)
+(defun span-set-end (span value)
   "Set the end point of SPAN to VALUE."
   (span-set-endpoints span (span-start span) value))
 
@@ -231,7 +222,7 @@ Return nil if no such overlay belong to the list."
 (defun span-make-self-removing-span (beg end &rest props)
   "Add a self-removing span from BEG to END with properties PROPS.
 The span will remove itself after a timeout of 2 seconds."
-  (let ((ol (make-overlay beg end)))
+  (let ((ol (span-make beg end)))
     (while props
       (overlay-put ol (car props) (cadr props))
       (setq props (cddr props)))
@@ -247,12 +238,12 @@ The span will remove itself after a timeout of 2 seconds."
   "Add a self-removing span from BEG to END with properties PROPS.
 The span will remove itself after any edit within its range.
 Return the span."
-  (let ((ol (make-overlay beg end)))
+  (let ((ol (span-make beg end)))
     (while props
       (overlay-put ol (car props) (cadr props))
       (setq props (cddr props)))
     (span-set-property ol 'modification-hooks
-		       (list 'span-delete-self-modification-hook))
+                       (list 'span-delete-self-modification-hook))
     ol))