X-Git-Url: https://iankelling.org/git/?p=visible-mark;a=blobdiff_plain;f=visible-mark.el;h=1ca0419674ed38632872532587dc199a45abe9c4;hp=b5206db3e97af1b2d72f6ccdd86e8f8d577fea28;hb=4f4968067363ebcdb15178d1be0d2e79c8658342;hpb=fa4ab6367def680ff913cca6442b5c7bc3e486c1 diff --git a/visible-mark.el b/visible-mark.el index b5206db..1ca0419 100644 --- a/visible-mark.el +++ b/visible-mark.el @@ -46,8 +46,6 @@ "The overlays used in this buffer.") (make-variable-buffer-local 'visible-mark-overlays) -(defvar visible-mark-non-trailing-faces nil) - (defcustom visible-mark-inhibit-trailing-overlay t "If non-nil, inhibit trailing overlay with underline face." :group 'visible-mark @@ -67,32 +65,30 @@ "A list of buffer names to be excluded" :group 'visible-mark :type '(repeat regexp)) - -(defun visible-mark-initialize-faces () - (if (and visible-mark-inhibit-trailing-overlay - (null visible-mark-non-trailing-faces)) - (let (faces) - (dotimes (i visible-mark-max) - (let ((face (or (nth i visible-mark-faces) 'visible-mark-face)) - (symbol (intern (format "visible-mark-non-trailing-face%s" i)))) - (copy-face face symbol) - (set-face-attribute symbol nil - :foreground (or (face-attribute face :background) t) - :background 'unspecified - :underline t) - (push symbol faces))) - (setq visible-mark-non-trailing-faces (nreverse faces))))) (defun visible-mark-initialize-overlays () (mapcar 'delete-overlay visible-mark-overlays) (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) @@ -100,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) @@ -130,7 +136,6 @@ :group 'visible-mark (if visible-mark-mode (progn - (visible-mark-initialize-faces) (visible-mark-initialize-overlays) (add-hook 'post-command-hook 'visible-mark-move-overlays nil t)) (mapcar 'delete-overlay visible-mark-overlays)