1 ;;; visible-mark.el --- Make marks visible.
3 ;; Copyright (C) 2014 by Ian Kelling
5 ;; Maintainer: Ian Kelling <ian@iankelling.org>
6 ;; Author: Ian Kelling <ian@iankelling.org>
7 ;; Author: Yann Hodique
8 ;; Author: MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
9 ;; Author: John Foerch <jjfoerch@earthlink.net>
10 ;; Keywords: marking color faces
11 ;; URL: https://gitlab.com/iankelling/visible-mark
12 ;; Created: 2008-02-21
16 ;; This program is free software; you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation, either version 3 of the License, or
19 ;; (at your option) any later version.
21 ;; This program is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
32 ;; Emacs minor mode to highlight mark(s).
34 ;; Allows setting the number of marks to display, and the faces to display them.
36 ;; Example installation:
38 ;; 1. Put this file in Emacs's load-path
40 ;; 2. add custom faces to init file
41 ;; (require 'visible-mark)
42 ;; (global-visible-mark-mode 1) ;; or add (visible-mark-mode) to specific hooks
44 ;; 3. Add customizations. The defaults are very minimal. They could also be set
47 ;; (defface visible-mark-active ;; put this before (require 'visible-mark)
48 ;; '((((type tty) (class mono)))
49 ;; (t (:background "magenta"))) "")
50 ;; (setq visible-mark-max 2)
51 ;; (setq visible-mark-faces `(visible-mark-face1 my-visible-mark-face2))
54 ;; Additional useful functions like unpoping the mark are at
55 ;; http://www.emacswiki.org/emacs/MarkCommands
56 ;; and http://www.emacswiki.org/emacs/VisibleMark
60 ;; 2008-02-21 MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
62 ;; * visible-mark.el: Added function to inhibit trailing overlay.
64 ;; 2008-01-31 MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
66 ;; * visible-mark.el: Create formal emacs lisp file from
67 ;; http://www.emacswiki.org/cgi-bin/wiki/VisibleMark.
68 ;; Yann Hodique and Jorgen Schäfer are original authors.
69 ;; Added function to make multiple marks visible.
74 ;; Observed in circe, when the buffer has a right margin, and there
75 ;; is a mark at the beginning of a line, any text in the margin on that line
76 ;; gets styled with the mark's face. May also happen for left margins, but
77 ;; haven't tested yet.
79 ;; Patches / pull requests welcome.
86 (defgroup visible-mark nil
87 "Show the position of your mark."
89 :prefix "visible-mark-")
91 (defface visible-mark-active
92 '((((type tty) (class color))
93 (:background "gray" :foreground "black"))
94 (((type tty) (class mono))
96 (((class color) (background dark))
97 (:background "gray" :foreground "black"))
98 (((class color) (background light))
99 (:background "grey80"))
100 (t (:background "gray")))
101 "Face for the active mark. To redefine this in your init file,
102 do it before loading/requiring visible-mark."
103 :group 'visible-mark)
105 (defcustom visible-mark-inhibit-trailing-overlay t
106 "If non-nil, inhibit the extension of an overlay at the end of a line
107 to the window margin."
111 (defcustom global-visible-mark-mode-exclude-alist nil
112 "A list of buffer names to be excluded."
114 :type '(repeat regexp))
117 (defcustom visible-mark-max 1
118 "The number of marks in the backward direction to be visible."
122 (defcustom visible-mark-forward-max 0
123 "The number of marks in the forward direction to be visible."
127 (defcustom visible-mark-faces nil
128 "A list of mark faces for marks in the backward direction.
129 If visible-mark-max is greater than the amount of visible-mark-faces,
130 the last defined face will be reused."
132 :type '(repeat face))
134 (defcustom visible-mark-forward-faces nil
135 "A list of mark faces for marks in the forward direction."
137 :type '(repeat face))
142 (defface visible-mark-face1
143 '((((type tty) (class mono)))
144 (t (:background "light salmon")))
145 "Example face which can be customized and added to subsequent face lists."
146 :group 'visible-mark)
148 (defface visible-mark-face2
149 '((((type tty) (class mono)))
150 (t (:background "light goldenrod")))
151 "Example face which can be customized and added to subsequent face lists."
152 :group 'visible-mark)
154 (defface visible-mark-forward-face1
155 '((((type tty) (class mono)))
156 (t (:background "pale green")))
157 "Example face which can be customized and added to subsequent face lists."
158 :group 'visible-mark)
160 (defface visible-mark-forward-face2
162 "Placeholder face for customization and addition to subsequent face lists."
163 :group 'visible-mark)
168 (defvar visible-mark-overlays nil
169 "The overlays used for mark faces. Used internally by visible-mark-mode.")
170 (make-variable-buffer-local 'visible-mark-overlays)
174 (defun visible-mark-initialize-overlays ()
177 (when (eq 'visible-mark (overlay-get x 'category))
179 (overlays-in (point-min) (point-max)))
181 (dotimes (i (+ visible-mark-max visible-mark-forward-max))
182 (let ((overlay (make-overlay (point-min) (point-min))))
183 (overlay-put overlay 'category 'visible-mark)
184 (push overlay overlays)))
185 (setq visible-mark-overlays (nreverse overlays))))
187 (defun visible-mark-find-overlay-at (pos)
188 (let ((overlays (overlays-at pos))
190 (while (and overlays (not found))
191 (let ((overlay (car overlays)))
192 (if (eq 'visible-mark (overlay-get overlay 'category))
193 (setq found overlay)))
194 (setq overlays (cdr overlays)))
197 (defun visible-mark-move-overlays ()
198 "Update overlays in `visible-mark-overlays'. This is run in the `post-command-hook'"
199 (mapc (lambda (x) (delete-overlay x))
200 visible-mark-overlays)
201 (let ((marks (cons (mark-marker) mark-ring))
202 (overlays visible-mark-overlays)
203 (faces visible-mark-faces)
204 (faces-forward visible-mark-forward-faces))
205 (if mark-active (setq faces (cons 'visible-mark-active (cdr faces))))
206 (dotimes (i visible-mark-max)
207 (visible-mark-move-overlay (pop overlays) (pop marks) (car faces))
208 (if (cdr faces) (pop faces)))
209 (dotimes (i visible-mark-forward-max)
210 (visible-mark-move-overlay (pop overlays) (car (last marks (1+ i))) (car faces-forward))
211 (if (cdr faces-forward) (pop faces-forward)))))
213 (defun visible-mark-move-overlay (overlay mark face)
214 "Set OVERLAY to position of MARK and display of FACE."
215 (let ((pos (and mark (marker-position mark))))
216 (when (and pos (not (equal (point) pos)))
219 visible-mark-inhibit-trailing-overlay
220 (save-excursion (goto-char pos) (eolp)))
221 (overlay-put overlay 'face nil)
222 (if (visible-mark-find-overlay-at pos)
223 (progn (overlay-put overlay 'before-string nil))
224 (overlay-put overlay 'before-string
228 (move-overlay overlay pos (1+ pos))))
230 (overlay-put overlay 'before-string nil)
231 (overlay-put overlay 'face face)
232 (move-overlay overlay pos (1+ pos)))))))
234 (require 'easy-mmode)
235 (defun visible-mark-mode-maybe ()
237 ((minibufferp (current-buffer)) nil)
238 ((cl-flet ((fun (arg)
240 (or (string-match (car arg) (buffer-name))
242 (fun global-visible-mark-mode-exclude-alist)) nil)
244 (visible-mark-mode t)))
247 (define-minor-mode visible-mark-mode
248 "A mode to make the mark visible."
251 (if visible-mark-mode
253 (visible-mark-initialize-overlays)
254 (add-hook 'post-command-hook 'visible-mark-move-overlays nil t))
255 (mapc 'delete-overlay visible-mark-overlays)
256 (setq visible-mark-overlays nil)
257 (remove-hook 'post-command-hook 'visible-mark-move-overlays t)))
260 (define-global-minor-mode
261 global-visible-mark-mode visible-mark-mode visible-mark-mode-maybe
262 :group 'visible-mark)
264 (provide 'visible-mark)
265 ;;; visible-mark.el ends here