From xemacs-m  Sat Jun 21 01:38:31 1997
Received: from jagor.srce.hr (hniksic@jagor.srce.hr [161.53.2.130])
	by xemacs.org (8.8.5/8.8.5) with ESMTP id BAA17522
	for <xemacs-beta@xemacs.org>; Sat, 21 Jun 1997 01:38:30 -0500 (CDT)
Received: (from hniksic@localhost)
          by jagor.srce.hr (8.8.5/8.8.4)
	  id IAA18335; Sat, 21 Jun 1997 08:38:29 +0200 (MET DST)
To: XEmacs Developers <xemacs-beta@xemacs.org>
Subject: Serious bugs in overlay.el
X-Attribution: Hrv
X-Face: Mie8:rOV<\c/~z{s.X4A{!?vY7{drJ([U]0O=W/<W*SMo/Mv:58:*_y~ki>xDi&N7XG
        KV^$k0m3Oe/)'e%3=$PCR&3ITUXH,cK>]bci&<qQ>Ff%x_>1`T(+M2Gg/fgndU%k*ft
        [(7._6e0n-V%|%'[c|q:;}td$#INd+;?!-V=c8Pqf}3J
From: Hrvoje Niksic <hniksic@srce.hr>
Date: 21 Jun 1997 08:38:28 +0200
Message-ID: <kigoh905ul7.fsf@jagor.srce.hr>
Lines: 197
X-Mailer: Gnus v5.4.59/XEmacs 20.3(beta7) - "Oslo"

The overlay emulation contains serious bugs.  For example,
`next-overlay-change' returns only end positions, end
`previous-overlay-change' returns only start positions.  Then,
`overlay-lists' contains an off-by-one error that can give wrong
results.

With apologies to Joe, there are horrible inefficiencies, too.
Instead of using `map-extents', the functions often cons up an
extent-list with *all* the extents in the buffer (possibly thousands
of them!)  The lists are constructed with `append', thus giving them
O(n^2) time, and there are unnecessary temporary variables in the
code.  All that consing... *shudder*

The following patch should clean all of this up.  As far as I could
check, the behavior is now the same as in GNU Emacs.  Can you please
check whether this is correct?

--- lisp/prim/overlay.el.orig	Sat Jun 21 06:51:00 1997
+++ lisp/prim/overlay.el	Sat Jun 21 08:28:01 1997
@@ -24,6 +24,15 @@
 
 ;;; Synched up with: Not in FSF.
 
+;;; Commentary:
+
+;; Written by Joe Nuspl in 1997.
+;;
+;; Some functions were broken; fixed-up by Hrvoje Niksic, June 1997.
+
+
+;;; Code:
+
 (defun overlayp (object)
   "Return t if OBJECT is an overlay."
   (and (extentp object)
@@ -37,23 +46,17 @@
 front delimiter advance when text is inserted there.
 The fifth arg REAR-ADVANCE, if non-nil, makes the
 rear delimiter advance when text is inserted there."
-  (let (overlay temp)
-    (if (null buffer)
-	(setq buffer (current-buffer))
-      (check-argument-type 'bufferp buffer))
-
-    (if (> beg end)
-	(setq temp beg
-	      beg end
-	      end temp))
+  (if (null buffer)
+      (setq buffer (current-buffer))
+    (check-argument-type 'bufferp buffer))
+  (when (> beg end)
+    (setq beg (prog1 end (setq end beg))))
 
-    (setq overlay (make-extent beg end buffer))
+  (let ((overlay (make-extent beg end buffer)))
     (set-extent-property overlay 'overlay t)
-
     (if front-advance
 	(set-extent-property overlay 'start-open t)
       (set-extent-property overlay 'start-closed t))
-
     (if rear-advance
 	(set-extent-property overlay 'end-closed t)
       (set-extent-property overlay 'end-open t))
@@ -65,27 +68,19 @@
 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
 buffer."
-  (let (temp)
-    (check-argument-type 'overlayp overlay)
-    (if (null buffer)
-	(setq buffer (extent-object overlay)))
-    
-    (if (null buffer)
-	(setq buffer (current-buffer)))
-    
-    (check-argument-type 'bufferp buffer)
-    
-    (if (and (= beg end)
-	     (not (null (extent-property overlay 'evaporate))))
-	(delete-overlay overlay)
-
-      (if (> beg end)
-	  (setq temp beg
-		beg end
-		end temp))
-
-      (set-extent-endpoints overlay beg end buffer)
-      overlay)))
+  (check-argument-type 'overlayp overlay)
+  (if (null buffer)
+      (setq buffer (extent-object overlay)))
+  (if (null buffer)
+      (setq buffer (current-buffer)))
+  (check-argument-type 'bufferp buffer)
+  (and (= beg end)
+       (extent-property overlay 'evaporate)
+       (delete-overlay overlay))
+  (when (> beg end)
+    (setq beg (prog1 end (setq end beg))))
+  (set-extent-endpoints overlay beg end buffer)
+  overlay)
 
 (defun delete-overlay (overlay)
   "Delete the overlay OVERLAY from its buffer."
@@ -125,37 +120,34 @@
 and also contained within the specified region.
 Empty overlays are included in the result if they are located at BEG
 or between BEG and END."
-  (let (lst)
-    (mapcar (function
-	     (lambda (overlay)
-	       (and (extent-property overlay 'overlay)
-		    (setq lst (append lst (list overlay))))))
-	    (extent-list nil beg end))
-    lst))
+  (mapcar-extents #'identity nil nil beg end nil 'overlay))
 
 (defun next-overlay-change (pos)
   "Return the next position after POS where an overlay starts or ends.
 If there are no more overlay boundaries after POS, return (point-max)."
   (let ((next (point-max))
-	end)
-    (mapcar (function
-	     (lambda (overlay)
-	       (if (< (setq end (extent-end-position overlay)) next)
-		   (setq next end))))
-	    (overlays-in pos end))
+	tmp)
+    (mapc (lambda (overlay)
+	    (when (or (and (< (setq tmp (extent-start-position overlay)) next)
+			   (> tmp pos))
+		      (and (< (setq tmp (extent-end-position overlay)) next)
+			   (> tmp pos)))
+	      (setq next tmp)))
+	  (overlays-in pos next))
     next))
 
 (defun previous-overlay-change (pos)
   "Return the previous position before POS where an overlay starts or ends.
 If there are no more overlay boundaries before POS, return (point-min)."
   (let ((prev (point-min))
-	beg)
-    (mapcar (function
-	     (lambda (overlay)
-	       (if (and (> (setq beg (extent-start-position overlay)) prev)
-			(< beg pos))
-		   (setq prev beg))))
-	    (overlays-in prev pos))
+	tmp)
+    (mapc (lambda (overlay)
+	    (when (or (and (> (setq tmp (extent-end-position overlay)) prev)
+			   (< tmp pos))
+		      (and (> (setq tmp (extent-start-position overlay)) prev)
+			   (< tmp pos)))
+	      (setq prev tmp)))
+	  (overlays-in prev pos))
     prev))
 
 (defun overlay-lists ()
@@ -165,19 +157,17 @@
 Recentering overlays moves overlays between these lists.
 The lists you get are copies, so that changing them has no effect.
 However, the overlays you get are the real objects that the buffer uses."
-  (if (not (boundp 'xemacs-internal-overlay-center-pos))
-      (overlay-recenter (/ (- (point-max) (point-min)) 2)))
+  (or (boundp 'xemacs-internal-overlay-center-pos)
+      (overlay-recenter (1+ (/ (- (point-max) (point-min)) 2))))
   (let ((pos xemacs-internal-overlay-center-pos)
 	before after)
-    (mapcar
-     (function
-      (lambda (overlay)
-	(if (extent-property overlay 'overlay)
-	    (if (> pos (extent-end-position overlay))
-		(setq before (append before (list overlay)))
-	      (setq after (append after (list overlay)))))))
-     (extent-list))
-    (cons before after)))
+    (map-extents (lambda (overlay ignore)
+		   (if (> pos (extent-end-position overlay))
+		       (push overlay before)
+		     (push overlay after))
+		   nil)
+		 nil nil nil nil nil 'overlay)
+    (cons (nreverse before) (nreverse after))))
 
 (defun overlay-recenter (pos)
   "Recenter the overlays of the current buffer around position POS."


-- 
Hrvoje Niksic <hniksic@srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
* Q: What is an experienced Emacs user?
* A: A person who wishes that the terminal had pedals.

