mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-01 08:17:38 +00:00
Code Issues Releases Activity

lisp/emacs-lisp/cl-extra.el (cl--map-overlays): Remove obsolete code.

Browse Source
This commit is contained in:
Juanma Barranquero 2014-03-20 19:16:47 +01:00
parent b730af2607
commit 814e26fa05
2 changed files with 16 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lisp/ChangeLog
View File

@ -1,5 +1,7 @@
2014-03-20 Juanma Barranquero <lekktu@gmail.com>
* emacs-lisp/cl-extra.el (cl--map-overlays): Remove obsolete code.
* skeleton.el (skeleton-autowrap): Mark as obsolete. Doc fix.
2014-03-20 Stefan Monnier <monnier@iro.umontreal.ca>

51
lisp/emacs-lisp/cl-extra.el
View File

@ -269,43 +269,20 @@ If so, return the true (non-nil) value returned by PREDICATE.
;;;###autoload
(defun cl--map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
(or cl-buffer (setq cl-buffer (current-buffer)))
(if (fboundp 'overlay-lists)
;; This is the preferred algorithm, though overlay-lists is undocumented.
(let (cl-ovl)
(with-current-buffer cl-buffer
(setq cl-ovl (overlay-lists))
(if cl-start (setq cl-start (copy-marker cl-start)))
(if cl-end (setq cl-end (copy-marker cl-end))))
(setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl)))
(while (and cl-ovl
(or (not (overlay-start (car cl-ovl)))
(and cl-end (>= (overlay-start (car cl-ovl)) cl-end))
(and cl-start (<= (overlay-end (car cl-ovl)) cl-start))
(not (funcall cl-func (car cl-ovl) cl-arg))))
(setq cl-ovl (cdr cl-ovl)))
(if cl-start (set-marker cl-start nil))
(if cl-end (set-marker cl-end nil)))
;; This alternate algorithm fails to find zero-length overlays.
(let ((cl-mark (with-current-buffer cl-buffer
(copy-marker (or cl-start (point-min)))))
(cl-mark2 (and cl-end (with-current-buffer cl-buffer
(copy-marker cl-end))))
cl-pos cl-ovl)
(while (save-excursion
(and (setq cl-pos (marker-position cl-mark))
(< cl-pos (or cl-mark2 (point-max)))
(progn
(set-buffer cl-buffer)
(setq cl-ovl (overlays-at cl-pos))
(set-marker cl-mark (next-overlay-change cl-pos)))))
(while (and cl-ovl
(or (/= (overlay-start (car cl-ovl)) cl-pos)
(not (and (funcall cl-func (car cl-ovl) cl-arg)
(set-marker cl-mark nil)))))
(setq cl-ovl (cdr cl-ovl))))
(set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil)))))
(let (cl-ovl)
(with-current-buffer cl-buffer
(setq cl-ovl (overlay-lists))
(if cl-start (setq cl-start (copy-marker cl-start)))
(if cl-end (setq cl-end (copy-marker cl-end))))
(setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl)))
(while (and cl-ovl
(or (not (overlay-start (car cl-ovl)))
(and cl-end (>= (overlay-start (car cl-ovl)) cl-end))
(and cl-start (<= (overlay-end (car cl-ovl)) cl-start))
(not (funcall cl-func (car cl-ovl) cl-arg))))
(setq cl-ovl (cdr cl-ovl)))
(if cl-start (set-marker cl-start nil))
(if cl-end (set-marker cl-end nil))))
;;; Support for `setf'.
;;;###autoload