1 ;;; visible-mark.el --- Make marks visible.
5 ;; This was hacked together by Jorgen Schäfer
6 ;; And hacked again by Yann Hodique
7 ;; Donated to the public domain. Use at your own risk.
10 ;; 2008-02-21 MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
12 ;; * visible-mark.el: Added function to inhibit trailing overlay.
14 ;; 2008-01-31 MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
16 ;; * visible-mark.el: Create formal emacs lisp file from
17 ;; http://www.emacswiki.org/cgi-bin/wiki/VisibleMark.
18 ;; Yann Hodique and Jorgen Schäfer are original authors.
19 ;; Added function to make multiple marks visible.
27 (defgroup visible-mark nil
28 "Show the position of your mark."
30 :prefix "visible-mark-")
32 (defface visible-mark-face
33 `((((type tty) (class color))
34 (:background "gray" :foreground "black"))
35 (((type tty) (class mono))
37 (((class color) (background dark))
38 (:background "gray" :foreground "black"))
39 (((class color) (background light))
40 (:background "grey80"))
41 (t (:background "gray")))
45 (defvar visible-mark-overlays nil
46 "The overlays used in this buffer.")
47 (make-variable-buffer-local 'visible-mark-overlays)
49 (defcustom visible-mark-inhibit-trailing-overlay t
50 "If non-nil, inhibit trailing overlay with underline face."
54 (defcustom visible-mark-max 1
55 "A number of mark to be visible."
59 (defcustom visible-mark-faces nil
60 "A list of mark faces."
64 (defcustom global-visible-mark-mode-exclude-alist nil
65 "A list of buffer names to be excluded"
67 :type '(repeat regexp))
69 (defun visible-mark-initialize-overlays ()
70 (mapc 'delete-overlay visible-mark-overlays)
72 (dotimes (i visible-mark-max)
73 (let ((overlay (make-overlay (point-min) (point-min))))
74 (overlay-put overlay 'category 'visible-mark)
75 (push overlay overlays)))
76 (setq visible-mark-overlays (nreverse overlays))))
78 (defun visible-mark-find-overlay-at (pos)
79 (let ((overlays (overlays-at pos))
81 (while (and overlays (not found))
82 (let ((overlay (car overlays)))
83 (if (eq 'visible-mark (overlay-get overlay 'category))
84 (setq found overlay)))
85 (setq overlays (cdr overlays)))
88 (defun visible-mark-move-overlays ()
89 "Move the overlay in `visible-mark-overlay' to a new position."
90 (mapc (lambda (x) (move-overlay x 0 0))
91 visible-mark-overlays)
92 (let ((marks (cons (mark-marker) mark-ring))
93 (overlays visible-mark-overlays))
94 (dotimes (i visible-mark-max)
95 (let* ((mark (car-safe marks))
96 (overlay (car overlays))
97 (pos (and mark (marker-position mark))))
100 ((and visible-mark-inhibit-trailing-overlay
101 (save-excursion (goto-char pos) (eolp)))
102 (overlay-put overlay 'face nil)
103 (if (visible-mark-find-overlay-at pos)
104 (progn (overlay-put overlay 'before-string nil)
105 (move-overlay overlay 0 0))
106 (overlay-put overlay 'before-string
109 'face (or (nth i visible-mark-faces) 'visible-mark-face)
111 (move-overlay overlay pos (1+ pos))))
113 (overlay-put overlay 'before-string nil)
114 (overlay-put overlay 'face
115 (or (nth i visible-mark-faces) 'visible-mark-face))
116 (move-overlay overlay pos (1+ pos)))))
117 (setq marks (cdr marks)))
118 (setq overlays (cdr overlays)))))
120 (require 'easy-mmode)
122 (defun visible-mark-mode-maybe ()
124 ((minibufferp (current-buffer)) nil)
127 (or (string-match (car arg) (buffer-name))
129 (fun global-visible-mark-mode-exclude-alist)) nil)
131 (visible-mark-mode t)))
133 (define-minor-mode visible-mark-mode
134 "A mode to make the mark visible."
137 (if visible-mark-mode
139 (visible-mark-initialize-overlays)
140 (add-hook 'post-command-hook 'visible-mark-move-overlays nil t))
141 (mapc 'delete-overlay visible-mark-overlays)
142 (setq visible-mark-overlays nil)
143 (remove-hook 'post-command-hook 'visible-mark-move-overlays t)))
145 (define-global-minor-mode
146 global-visible-mark-mode visible-mark-mode visible-mark-mode-maybe
147 :group 'visible-mark)
149 (provide 'visible-mark)
150 ;;; visible-mark.el ends here