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 (mapcar 'delete-overlay visible-mark-overlays)
72 (dotimes (i visible-mark-max)
73 (let ((overlay (make-overlay (point-min) (point-min))))
74 (push overlay overlays)))
75 (setq visible-mark-overlays (nreverse overlays))))
77 (defun visible-mark-move-overlays ()
78 "Move the overlay in `visible-mark-overlay' to a new position."
79 (let ((marks (cons (mark-marker) mark-ring))
80 (overlays visible-mark-overlays))
81 (dotimes (i visible-mark-max)
82 (let* ((mark (car-safe marks))
83 (overlay (car overlays))
84 (pos (and mark (marker-position mark))))
86 (overlay-put overlay 'face
87 (if (and visible-mark-inhibit-trailing-overlay
91 (nth i visible-mark-non-trailing-faces)
92 (or (nth i visible-mark-faces) 'visible-mark-face)))
93 (move-overlay overlay pos (1+ pos)))
94 (setq marks (cdr marks)))
95 (setq overlays (cdr overlays)))))
99 (defun visible-mark-mode-maybe ()
101 ((minibufferp (current-buffer)) nil)
104 (or (string-match (car arg) (buffer-name))
106 (fun global-visible-mark-mode-exclude-alist)) nil)
108 (visible-mark-mode t)))
110 (define-minor-mode visible-mark-mode
111 "A mode to make the mark visible."
114 (if visible-mark-mode
116 (visible-mark-initialize-overlays)
117 (add-hook 'post-command-hook 'visible-mark-move-overlays nil t))
118 (mapcar 'delete-overlay visible-mark-overlays)
119 (setq visible-mark-overlays nil)
120 (remove-hook 'post-command-hook 'visible-mark-move-overlays t)))
122 (define-global-minor-mode
123 global-visible-mark-mode visible-mark-mode visible-mark-mode-maybe
124 :group 'visible-mark)
126 (provide 'visible-mark)
127 ;;; visible-mark.el ends here