1 ;;; minimap.el --- Sidebar showing a minimap of the current buffer
3 ;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
5 ;; Author: David Engster <dengste@eml.cc>
9 ;; This file is part of GNU Emacs.
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License
13 ;; as published by the Free Software Foundation; either version 2
14 ;; of the License, or (at your option) any later version.
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
26 ;; This file is an implementation of a minimap sidebar, i.e., a
27 ;; smaller display of the current buffer on the left side. It
28 ;; highlights the currently shown region and updates its position
29 ;; automatically. You can navigate in the minibar by dragging the
30 ;; active region with the mouse, which will scroll the corresponding
33 ;; To create the minimap sidebar, type M-x minimap-create.
34 ;; To dismiss it, type M-x minimap-kill.
37 ;; * Use 'M-x minimap-create' in a buffer you're currently editing.
38 ;; * Use 'M-x minimap-kill' to kill the minimap.
39 ;; * Use 'M-x customize-group RET minimap RET' to adapt minimap to your needs.
43 ;; * Currently cannot deal with images.
44 ;; * Display/movement can be a bit erratic at times.
49 ;; * Make sidebar permanently visible. This requires something like a
50 ;; 'window group' feature in Emacs, which is currently being worked on.
51 ;; * Moving the active region with the keyboard / mouse-wheel ?
54 ;;; Customizable variables:
57 "A minimap sidebar for Emacs."
60 (defface minimap-font-face
61 '((default :family "DejaVu Sans Mono" :height 30))
62 "Face used for text in minimap buffer, notably the font family and height.
63 This height should be really small. You probably want to use a
64 TrueType font for this. After changing this, you should
65 recreate the minimap to avoid problems with recentering."
68 (defface minimap-active-region-background
69 '((((background dark)) (:background "#4517305D0000"))
70 (t (:background "#C847D8FEFFFF")))
71 "Face for the active region in the minimap.
72 By default, this is only a different background color."
75 (defface minimap-semantic-function-face
76 '((((background dark))
77 (:box (:line-width 1 :color "white")
78 :inherit (font-lock-function-name-face minimap-font-face)
79 :height 2.5 :background "gray10"))
80 (t (:box (:line-width 1 :color "black")
81 :inherit (font-lock-function-name-face minimap-font-face)
82 :height 2.5 :background "gray90")))
83 "Face used for functions in the semantic overlay.")
85 (defface minimap-semantic-variable-face
86 '((((background dark))
87 (:box (:line-width 1 :color "white")
88 :inherit (font-lock-variable-name-face minimap-font-face)
89 :height 2.5 :background "gray10"))
90 (t (:box (:line-width 1 :color "black")
91 :inherit (font-lock-function-name-face minimap-font-face)
92 :height 2.5 :background "gray90")))
93 "Face used for variables in the semantic overlay.")
95 (defface minimap-semantic-type-face
96 '((((background dark))
97 (:box (:line-width 1 :color "white")
98 :inherit (font-lock-type-face minimap-font-face)
99 :height 2.5 :background "gray10"))
100 (t (:box (:line-width 1 :color "black")
101 :inherit (font-lock-function-name-face minimap-font-face)
102 :height 2.5 :background "gray90")))
103 "Face used for types in the semantic overlay.")
105 (defcustom minimap-width-fraction 0.2
106 "Fraction of width which should be used for minimap sidebar."
110 (defcustom minimap-window-location 'left
111 "Location of the minimap window.
112 Can be either the symbol `left' or `right'."
113 :type '(choice (const :tag "Left" left)
114 (const :tag "Right" right))
117 (defcustom minimap-buffer-name-prefix "*MINIMAP* "
118 "Prefix for buffer names of minimap sidebar."
122 (defcustom minimap-update-delay 0.2
123 "Delay in seconds after which sidebar gets updated.
124 Setting this to 0 will let the minimap react immediately, but
125 this will slow down scrolling."
127 :set (lambda (sym value)
129 (when (and (boundp 'minimap-timer-object)
130 minimap-timer-object)
131 (cancel-timer minimap-timer-object)
132 (setq minimap-timer-object
134 minimap-update-delay t 'minimap-update))))
137 (defcustom minimap-always-recenter nil
138 "Whether minimap sidebar should be recentered after every point movement."
142 (defcustom minimap-recenter-type 'relative
143 "Specifies the type of recentering the minimap should use.
144 The minimap can use different types of recentering, i.e., how the
145 minimap should behave when you scroll in the main window or when
146 you drag the active region with the mouse. The following
147 explanations will probably not help much, so simply try them and
148 choose the one which suits you best.
150 `relative' -- The position of the active region in the minimap
151 corresponds with the relative position of this region in the
152 buffer. This the default.
154 `middle' -- The active region will stay fixed in the middle of
157 `free' -- The position will be more or less free. When dragging
158 the active region, the minimap will scroll when you reach the
160 :type '(choice (const :tag "Relative" relative)
161 (const :tag "Middle" middle)
162 (const :tag "Free" free))
165 (defcustom minimap-hide-scroll-bar t
166 "Whether the minimap should hide the vertical scrollbar."
170 (defcustom minimap-hide-fringes t
171 "Whether the minimap should hide the fringes."
175 (defcustom minimap-dedicated-window nil
176 "Whether the minimap should create a dedicated window."
180 (defcustom minimap-display-semantic-overlays t
181 "Display overlays from CEDET's semantic analyzer.
182 If you use CEDET and the buffer's major-mode is supported, the
183 minimap can display overlays generated by the semantic analyzer.
184 By default, it will apply the faces `minimap-semantic-<X>-face',
185 with <X> being \"function\", \"variable\" and \"type\". Also, it
186 will display the name of the tag in the middle of the overlay in
187 the corresponding font-lock face.
189 See also `minimap-enlarge-certain-faces', which can be used as
194 (defcustom minimap-enlarge-certain-faces 'as-fallback
195 "Whether certain faces should be enlarged in the minimap.
196 All faces listed in `minimap-normal-height-faces' will be
197 displayed using the default font height, allowing you to still
198 read text using those faces. By default, this should enlarge all
199 function names in the minimap, given you have font locking
200 enabled. This variable can have the following values:
202 'as-fallback (the default) -- The feature will only be activated
203 if information from CEDET's semantic analyzer isn't available
204 (see: `minimap-display-semantic-overlays').
205 'always -- Always active.
207 :type '(choice (const :tag "Fallback if CEDET unavailable." 'as-fallback)
208 (const :tag "Always active." 'always)
209 (const :tag "Inactive." nil))
212 (defcustom minimap-normal-height-faces '(font-lock-function-name-face)
213 "List of faces which should be displayed with normal height.
214 When `minimap-enlarge-certain-faces' is non-nil, all faces in
215 this list will be displayed using the default font height. By
216 default, this list contains `font-lock-function-name-face', so
217 you can still read function names in the minimap."
221 (defcustom minimap-sync-overlay-properties '(face invisible)
222 "Specifies which overlay properties should be synced.
223 Unlike text properties, overlays are not applied automatically to
224 the minimap and must be explicitly synced. This variable
225 specifies which overlay properties should be synced by
226 `minimap-sync-overlays'. Most importantly, this variable should
227 include 'invisible', so that hidden text does not appear in the
229 :type '(repeat symbol)
232 ;;; Internal variables
234 (defvar minimap-start nil)
235 (defvar minimap-end nil)
236 (defvar minimap-active-overlay nil)
237 (defvar minimap-bufname nil)
238 (defvar minimap-timer-object nil)
239 (defvar minimap-active-minimaps 0)
240 (defvar minimap-base-overlay nil)
241 (defvar minimap-numlines nil)
242 (defvar minimap-pointmin-overlay nil)
244 (make-variable-buffer-local 'minimap-start)
245 (make-variable-buffer-local 'minimap-end)
246 (make-variable-buffer-local 'minimap-active-overlay)
247 (make-variable-buffer-local 'minimap-bufname)
248 (make-variable-buffer-local 'minimap-base-overlay)
249 (make-variable-buffer-local 'minimap-numlines)
250 (make-variable-buffer-local 'minimap-pointmin-overlay)
252 ;;; Minimap creation / killing
255 (defun minimap-create ()
256 "Create a minimap sidebar for the current window."
258 ;; If minimap is visible, do nothing.
259 (unless (and minimap-bufname
260 (get-buffer minimap-bufname)
261 (get-buffer-window (get-buffer minimap-bufname)))
262 (let ((bufname (concat minimap-buffer-name-prefix
263 (buffer-name (current-buffer))))
264 (new-win (if (eq minimap-window-location 'left)
265 (split-window-horizontally
266 (round (* (window-width)
267 minimap-width-fraction)))
268 (split-window-horizontally
269 (round (* (window-width)
270 (- 1 minimap-width-fraction))))
272 ;; If minimap exists but isn't visible, reuse it.
273 (if (and minimap-bufname
274 (get-buffer minimap-bufname))
275 (switch-to-buffer minimap-bufname t)
276 ;; Otherwise create new minimap
277 (minimap-new-minimap bufname)
278 ;; If this is the first minimap, create the idle timer.
279 (when (zerop minimap-active-minimaps)
280 (setq minimap-timer-object
281 (run-with-idle-timer minimap-update-delay t 'minimap-update)))
282 (setq minimap-active-minimaps
283 (1+ minimap-active-minimaps))))
285 (minimap-sync-overlays)))
287 (defun minimap-new-minimap (bufname)
288 "Create new minimap BUFNAME for current buffer and window."
289 (let ((indbuf (make-indirect-buffer (current-buffer) bufname t))
290 (edges (window-pixel-edges)))
291 (setq minimap-bufname bufname)
293 (when minimap-hide-scroll-bar
294 (setq vertical-scroll-bar nil))
295 (switch-to-buffer indbuf)
296 (setq minimap-base-overlay (make-overlay (point-min) (point-max) nil t t))
297 (overlay-put minimap-base-overlay 'face 'minimap-font-face)
298 (overlay-put minimap-base-overlay 'priority 1)
299 (setq minimap-pointmin-overlay (make-overlay (point-min) (1+ (point-min))))
300 (setq minimap-start (window-start)
301 minimap-end (window-end)
302 minimap-active-overlay (make-overlay minimap-start minimap-end)
304 (overlay-put minimap-active-overlay 'face
305 'minimap-active-region-background)
306 (overlay-put minimap-active-overlay 'priority 5)
308 (when (and (boundp 'linum-mode)
311 (when minimap-hide-fringes
312 (set-window-fringes nil 0 0))
313 (when minimap-dedicated-window
314 (set-window-dedicated-p nil t))
315 (setq buffer-read-only t)
316 ;; Calculate the actual number of lines displayable with the minimap face.
317 (setq minimap-numlines
320 (- (nth 3 edges) (nth 1 edges))
321 (car (progn (redisplay) (window-line-height))))))))
324 (defun minimap-kill ()
325 "Kill minimap for current buffer.
326 Cancel the idle timer if no more minimaps are active."
328 (if (null minimap-bufname)
329 (message "No minimap associated with %s." (buffer-name (current-buffer)))
330 (let ((curname (buffer-name (current-buffer)))
331 (buf (get-buffer minimap-bufname))
332 (win (get-buffer-window minimap-bufname)))
333 (setq minimap-bufname nil)
335 (message "No minimap associated with %s." curname)
340 (setq minimap-active-minimaps
341 (1- minimap-active-minimaps)))
342 (cancel-timer minimap-timer-object)
343 (setq minimap-timer-object nil))
344 (message "Minimap for %s killed." curname)))))
348 (defun minimap-update (&optional force)
349 "Update minimap sidebar if necessary.
350 This is meant to be called from the idle-timer or the post command hook.
351 When FORCE, enforce update of the active region."
352 (when minimap-bufname
353 (let ((win (get-buffer-window minimap-bufname))
356 (setq start (window-start)
360 (with-selected-window win
361 (unless (and (not force)
362 (= minimap-start start)
364 (move-overlay minimap-active-overlay start end)
365 (setq minimap-start start
367 (minimap-recenter (line-number-at-pos (/ (+ end start) 2))
368 (/ (- (line-number-at-pos end)
369 (line-number-at-pos start))
372 (when minimap-always-recenter
373 (recenter (round (/ (window-height) 2)))))))))
377 (defun minimap-move-overlay-mouse (start-event)
378 "Move overlay by tracking mouse movement."
380 (mouse-set-point start-event)
381 (when (get-buffer-window (buffer-base-buffer (current-buffer)))
382 (let* ((echo-keystrokes 0)
383 (end-posn (event-end start-event))
384 (start-point (posn-point end-posn))
385 (make-cursor-line-fully-visible nil)
387 (pcselmode (when (boundp 'pc-selection-mode)
390 (when (and pcselmode (fboundp 'pc-selection-mode))
391 (pc-selection-mode -1))
392 (move-overlay minimap-active-overlay start-point minimap-end)
394 (minimap-set-overlay start-point)
396 (consp (setq ev (read-event)))
397 (eq (car ev) 'mouse-movement))
398 (setq pt (posn-point (event-start ev)))
400 (minimap-set-overlay pt))))
401 (select-window (get-buffer-window (buffer-base-buffer)))
403 (when (and pcselmode (fboundp 'pc-selection-mode))
404 (pc-selection-mode 1)))))
406 (defun minimap-set-overlay (pt)
407 "Set overlay position, with PT being the middle."
409 (let* ((ovstartline (line-number-at-pos minimap-start))
410 (ovendline (line-number-at-pos minimap-end))
411 (ovheight (round (/ (- ovendline ovstartline) 2)))
412 (line (line-number-at-pos))
413 (winstart (window-start))
414 (winend (window-end))
416 (setq pt (point-at-bol))
417 (setq newstart (minimap-line-to-pos (- line ovheight)))
418 ;; Perform recentering
419 (minimap-recenter line ovheight)
420 ;; Set new position in main buffer and redisplay
421 (with-selected-window (get-buffer-window (buffer-base-buffer))
423 (set-window-start nil newstart)
425 (setq newend (window-end)))
426 (when (eq minimap-recenter-type 'free)
427 (while (> newend winend)
430 (setq winend (window-end))))
431 (move-overlay minimap-active-overlay newstart newend)))
433 (defun minimap-line-to-pos (line)
434 "Return point position of line number LINE."
437 (if (eq selective-display t)
438 (re-search-forward "[\n\C-m]" nil 'end (1- line))
439 (forward-line (1- line)))
442 (defun minimap-recenter (middle height)
443 "Recenter the minimap according to `minimap-recenter-type'.
444 MIDDLE is the line number in the middle of the active region.
445 HEIGHT is the number of lines from MIDDLE to begin/end of the
448 ;; Relative recentering
449 ((eq minimap-recenter-type 'relative)
450 (let* ((maxlines (line-number-at-pos (point-max)))
451 percentage relpos newline start numlines)
452 (setq numlines (count-lines (window-start) (window-end)))
453 (setq percentage (/ (float middle) (float maxlines)))
454 (setq newline (ceiling (* percentage numlines)))
455 (setq start (minimap-line-to-pos
458 (- numlines height height))))))
459 (or (> start (point-min))
460 (setq start (point-min)))
461 ;; If (point-max) already visible, don't go further
462 (if (and (> start (window-start))
463 (with-selected-window (get-buffer-window (buffer-base-buffer))
464 (= (point-max) (window-end))))
466 (goto-char (point-max))
468 (unless (and (> start (window-start))
469 (= (point-max) (window-end)))
470 (set-window-start nil start)))))
471 ;; Middle recentering
472 ((eq minimap-recenter-type 'middle)
473 (let ((start (- middle height
475 (- minimap-numlines height height))))))
478 ;; Hack: Emacs cannot scroll down any further, so we fake
479 ;; it using an overlay. Otherwise, the active region
480 ;; would move to the top.
481 (overlay-put minimap-pointmin-overlay
483 (make-string (abs start) 10)
484 (buffer-substring (point-min) (1+ (point-min)))))
485 (overlay-put minimap-pointmin-overlay
486 'face `(:background ,(face-background 'default)))
487 (overlay-put minimap-pointmin-overlay
490 (overlay-put minimap-pointmin-overlay 'display "")
491 (overlay-put minimap-pointmin-overlay 'face nil))
492 (set-window-start nil (minimap-line-to-pos start))))
494 ((eq minimap-recenter-type 'free)
495 (let ((newstart (minimap-line-to-pos (- middle height)))
496 (winstart (window-start)))
497 (while (< newstart winstart)
500 (setq winstart (window-start)))))))
502 ;;; Minimap minor mode
504 (defvar minimap-mode-map (make-sparse-keymap)
505 "Keymap used by `minimap-mode'.")
507 (define-key minimap-mode-map [down-mouse-1] 'minimap-move-overlay-mouse)
508 (define-key minimap-mode-map [down-mouse-2] 'minimap-move-overlay-mouse)
509 (define-key minimap-mode-map [down-mouse-3] 'minimap-move-overlay-mouse)
511 (define-minor-mode minimap-mode
512 "Minor mode for minimap sidebar."
513 nil "minimap" minimap-mode-map)
515 ;;; Sync minimap with modes which create/delete overlays.
517 (defun minimap-sync-overlays ()
518 "Synchronize overlays between base and minimap buffer.
519 Apply semantic overlays or face enlargement if necessary."
521 (when minimap-bufname
522 (let ((baseov (overlays-in (point-min) (point-max)))
523 (semantic (and (boundp 'semantic-version)
524 (semantic-active-p)))
526 (with-current-buffer minimap-bufname
529 (when (setq props (minimap-get-sync-properties (car baseov)))
530 (setq ov (make-overlay (overlay-start (car baseov))
531 (overlay-end (car baseov))))
532 (while (setq p (car props))
533 (overlay-put ov (car p) (cadr p))
534 (setq props (cdr props))))
535 (setq baseov (cdr baseov)))
536 (move-overlay minimap-pointmin-overlay (point-min) (1+ (point-min)))
537 ;; Re-apply font overlay
538 (move-overlay minimap-base-overlay (point-min) (point-max)))
540 (when (and font-lock-mode
541 (or (eq minimap-enlarge-certain-faces 'always)
542 (and (eq minimap-enlarge-certain-faces 'as-fallback)
543 (or (not minimap-display-semantic-overlays)
545 (when (eq font-lock-support-mode 'jit-lock-mode)
546 (jit-lock-fontify-now))
547 (with-current-buffer minimap-bufname
548 (minimap-enlarge-faces)))
551 minimap-display-semantic-overlays)
552 (minimap-apply-semantic-overlays)))
555 (defun minimap-get-sync-properties (ov)
556 "Get properties from overlay OV which should be synced.
557 You can specify those properties with
558 `minimap-sync-overlay-properties'."
562 (let ((val (overlay-get ov p)))
566 minimap-sync-overlay-properties)))
568 (defun minimap-enlarge-faces ()
569 "Apply default font to all faces in `minimap-normal-height-faces'.
570 This has to be called in the minimap buffer."
571 (let ((pos (next-single-property-change (point-min) 'face))
574 (setq face (get-text-property pos 'face))
575 (when (delq nil (mapcar (lambda (x) (equal x face))
576 minimap-normal-height-faces))
579 (setq pos (next-single-property-change pos 'face))))
580 (overlay-put ov 'face `(:family ,(face-font 'default)))
581 (overlay-put ov 'priority 5))
582 (setq pos (next-single-property-change pos 'face)))))
584 (defun minimap-apply-semantic-overlays ()
585 "Apply semantic overlays to the minimap.
586 This has to be called from the base buffer."
587 (let ((tags (semantic-fetch-tags))
590 (setq tag (car tags))
591 (setq class (semantic-tag-class tag))
592 (setq ov (semantic-tag-overlay tag))
593 (when (and (overlayp ov)
594 (or (eq class 'function)
596 (eq class 'variable)))
597 (with-current-buffer minimap-bufname
598 (let ((start (overlay-start ov))
599 (end (overlay-end ov))
600 (name (semantic-tag-name tag)))
602 (setq ovnew (make-overlay start end))
603 'face `(:background ,(face-background
604 (intern (format "minimap-semantic-%s-face"
605 (symbol-name class))))))
606 (overlay-put ovnew 'priority 1)
608 (minimap-line-to-pos (/ (+ (line-number-at-pos start)
609 (line-number-at-pos end)) 2)))
610 (setq end (progn (goto-char start) (point-at-eol)))
611 (setq ovnew (make-overlay start end))
612 (overlay-put ovnew 'face (format "minimap-semantic-%s-face"
613 (symbol-name class)))
614 (overlay-put ovnew 'display (concat " " name " "))
615 (overlay-put ovnew 'priority 6))))
616 (setq tags (cdr tags)))))
618 ;; outline-(minor-)mode
619 (add-hook 'outline-view-change-hook 'minimap-sync-overlays)
622 (add-hook 'hs-hide-hook 'minimap-sync-overlays)
623 (add-hook 'hs-show-hook 'minimap-sync-overlays)
627 ;;; minimap.el ends here