From: John Foerch Date: Tue, 7 Dec 2010 20:19:20 +0000 (-0500) Subject: visible-mark-move-overlays: rewrite X-Git-Tag: v0.1~13 X-Git-Url: https://iankelling.org/git/?a=commitdiff_plain;h=4f4968067363ebcdb15178d1be0d2e79c8658342;p=visible-mark visible-mark-move-overlays: rewrite still not perfect. has problems with reverting buffer, and with faces being shown in margin text. --- diff --git a/visible-mark.el b/visible-mark.el index c73dee5..1ca0419 100644 --- a/visible-mark.el +++ b/visible-mark.el @@ -71,11 +71,24 @@ (let (overlays) (dotimes (i visible-mark-max) (let ((overlay (make-overlay (point-min) (point-min)))) + (overlay-put overlay 'category 'visible-mark) (push overlay overlays))) (setq visible-mark-overlays (nreverse overlays)))) +(defun visible-mark-find-overlay-at (pos) + (let ((overlays (overlays-at pos)) + found) + (while (and overlays (not found)) + (let ((overlay (car overlays))) + (if (eq 'visible-mark (overlay-get overlay 'category)) + (setq found overlay))) + (setq overlays (cdr overlays))) + found)) + (defun visible-mark-move-overlays () "Move the overlay in `visible-mark-overlay' to a new position." + (mapc (lambda (x) (move-overlay x 0 0)) + visible-mark-overlays) (let ((marks (cons (mark-marker) mark-ring)) (overlays visible-mark-overlays)) (dotimes (i visible-mark-max) @@ -83,16 +96,26 @@ (overlay (car overlays)) (pos (and mark (marker-position mark)))) (when pos - (overlay-put overlay 'face - (if (and visible-mark-inhibit-trailing-overlay - (save-excursion - (goto-char pos) - (eolp))) - (nth i visible-mark-non-trailing-faces) - (or (nth i visible-mark-faces) 'visible-mark-face))) - (move-overlay overlay pos (1+ pos))) + (cond + ((and visible-mark-inhibit-trailing-overlay + (save-excursion (goto-char pos) (eolp))) + (overlay-put overlay 'face nil) + (if (visible-mark-find-overlay-at pos) + (progn (overlay-put overlay 'before-string nil) + (move-overlay overlay 0 0)) + (overlay-put overlay 'before-string + (propertize + " " + 'face (or (nth i visible-mark-faces) 'visible-mark-face) + 'cursor 0)) + (move-overlay overlay pos (1+ pos)))) + (t + (overlay-put overlay 'before-string nil) + (overlay-put overlay 'face + (or (nth i visible-mark-faces) 'visible-mark-face)) + (move-overlay overlay pos (1+ pos))))) (setq marks (cdr marks))) - (setq overlays (cdr overlays))))) + (setq overlays (cdr overlays))))) (require 'easy-mmode)