# HG changeset patch # User Stefan Monnier # Date 1006920233 0 # Node ID 812e52cc5162ca4e0cfba40cc3a253648515a874 # Parent fde712c2fd73780c222fdfb056e59fbb973373d0 (copy-overlay, remove-overlays): New funs. diff -r fde712c2fd73 -r 812e52cc5162 lisp/subr.el --- a/lisp/subr.el Wed Nov 28 03:06:45 2001 +0000 +++ b/lisp/subr.el Wed Nov 28 04:03:53 2001 +0000 @@ -993,7 +993,7 @@ (if all (save-excursion (set-buffer (other-buffer)))) (set-buffer-modified-p (buffer-modified-p))) -(defun momentary-string-display (string pos &optional exit-char message) +(defun momentary-string-display (string pos &optional exit-char message) "Momentarily display STRING in the buffer at POS. Display remains until next character is typed. If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed; @@ -1037,6 +1037,41 @@ (set-buffer-modified-p modified)))) +;;;; Overlay operations + +(defun copy-overlay (o) + "Return a copy of overlay O." + (let ((o1 (make-overlay (overlay-start o) (overlay-end o) + ;; FIXME: there's no easy way to find the + ;; insertion-type of the two markers. + (overlay-buffer o))) + (props (overlay-properties o))) + (while props + (overlay-put o1 (pop props) (pop props))) + o1)) + +(defun remove-overlays (beg end name val) + "Clear BEG and END of overlays whose property NAME has value VAL. +Overlays might be moved and or split." + (if (< end beg) + (setq beg (prog1 end (setq end beg)))) + (save-excursion + (dolist (o (overlays-in beg end)) + (when (eq (overlay-get o name) val) + ;; Either push this overlay outside beg...end + ;; or split it to exclude beg...end + ;; or delete it entirely (if it is contained in beg...end). + (if (< (overlay-start o) beg) + (if (> (overlay-end o) end) + (progn + (move-overlay (copy-overlay o) + (overlay-start o) beg) + (move-overlay o end (overlay-end o))) + (move-overlay o (overlay-start o) beg)) + (if (> (overlay-end o) end) + (move-overlay o end (overlay-end o)) + (delete-overlay o))))))) + ;;;; Miscellanea. ;; A number of major modes set this locally.