diff options
Diffstat (limited to 'lisp/minimap.el')
| -rw-r--r-- | lisp/minimap.el | 936 |
1 files changed, 936 insertions, 0 deletions
diff --git a/lisp/minimap.el b/lisp/minimap.el new file mode 100644 index 0000000..c360673 --- /dev/null +++ b/lisp/minimap.el @@ -0,0 +1,936 @@ +;;; minimap.el --- Sidebar showing a "mini-map" of a buffer + +;; Copyright (C) 2009-2020 Free Software Foundation, Inc. + +;; Author: David Engster <deng@randomsample.de> +;; Keywords: +;; Version: 1.3 + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file is an implementation of a minimap sidebar, i.e., a +;; smaller display of the current buffer on the left side. It +;; highlights the currently shown region and updates its position +;; automatically. You can navigate in the minibar by dragging the +;; active region with the mouse, which will scroll the corresponding +;; edit buffer. Additionally, you can overlay information from the +;; tags gathered by CEDET's semantic analyzer. + +;; Simply use M-x minimap-mode to toggle activation of the minimap. +;; Use 'M-x customize-group RET minimap RET' to adapt minimap to your +;; needs. + +;;; KNOWN BUGS: + +;; * Currently cannot deal with images. +;; * Display/movement can be a bit erratic at times. + +;;; TODO: + +;; * Fix known bugs. +;; * Make sidebar permanently visible. This requires something like a +;; 'window group' feature in Emacs, which is currently being worked on. +;; * Moving the active region with the keyboard / mouse-wheel ? + + +;;; News: +;; +;;;; Changes since v1.2: +;; +;; - New option: minimap-hide-cursor (active by default) +;; - New option: minimap-disable-mode-line (active by default) +;; - Make current line highlighting face configurable, change to dark gray. +;; - New default behavior for minimap-automatically-delete-window: +;; keep minimap window as long as buffer is visible. Change variable +;; to 't' to get old behavior. +;; - Bug fixes +;; +;;;; Changes since v1.1: +;; +;; - Change some defaults: better colors, reduced update delay. +;; - `minimap-tag-only': New experimental feature to only display an +;; 'abstract view' of the buffer with overlays generated from +;; Semantic information. Works only for buffers parsed by Semantic. +;; - `minimap-highlight-line': Highlight current line in Minimap. +;; - Fix autoloads. +;; - Display lines denoting beginning/end of functions in Semantic +;; overlays. +;; +;;;; Changes since v1.0: +;; +;; - Largely rewritten as a minor mode; use M-x minimap-mode to +;; enable/disable. +;; - Minimap will now remain active for all buffers which derive from +;; `prog-mode' (can be changed through `minimap-major-modes'). The +;; minimap window will be automatically created or deleted (see new +;; variables `minimap-recreate-window' and +;; `minimap-automatically-delete-window'). +;; - Possibility to set a minimum width of the minimap window +;; (`minimap-minimum-width'). +;; - Minimap window will be marked so that you should not be able to +;; enter it. +;; - Semantic overlays will be automatically updated during editing. +;; - Lots of bug fixes. + +;; Silence byte compiler +(declare-function semantic-active-p "semantic/fw") +(declare-function semantic-fetch-tags "semantic") +(declare-function semantic-tag-class "semantic/tag") +(declare-function semantic-tag-overlay "semantic/tag") +(declare-function semantic-tag-name "semantic/tag") + +(defgroup minimap nil + "A minimap sidebar for Emacs." + :group 'convenience) + +(defface minimap-font-face + '((default :family "DejaVu Sans Mono" :height 30)) + "Face used for text in minimap buffer, notably the font family and height. +This height should be really small. You probably want to use a +TrueType font for this. After changing this, you should +recreate the minimap to avoid problems with recentering." + :group 'minimap) + +(defface minimap-current-line-face + '((((background dark)) (:background "dark gray")) + (t (:background "dark gray"))) + "Face for the current line in the minimap. +By default, both foreground and background are yellow." + :group 'minimap) + +(defface minimap-active-region-background + '((((background dark)) (:background "#700000" :extend t)) + (t (:background "#C847D8FEFFFF" :extend t))) + "Face for the active region in the minimap. +By default, this is only a different background color." + :group 'minimap) + +(defface minimap-semantic-function-face + '((((background dark)) + (:box (:line-width 1 :color "white") + :inherit (font-lock-function-name-face minimap-font-face) + :height 2.75 :background "#202414")) + (t (:box (:line-width 1 :color "black") + :inherit (font-lock-function-name-face minimap-font-face) + :height 2.75 :background "gray90"))) + "Face used for functions in the semantic overlay.") + +(defface minimap-semantic-variable-face + '((((background dark)) + (:box (:line-width 1 :color "white") + :inherit (font-lock-variable-name-face minimap-font-face) + :height 2.75 :background "gray10")) + (t (:box (:line-width 1 :color "black") + :inherit (font-lock-function-name-face minimap-font-face) + :height 2.75 :background "gray90"))) + "Face used for variables in the semantic overlay.") + +(defface minimap-semantic-type-face + '((((background dark)) + (:box (:line-width 1 :color "white") + :inherit (font-lock-type-face minimap-font-face) + :height 2.75 :background "gray10")) + (t (:box (:line-width 1 :color "black") + :inherit (font-lock-function-name-face minimap-font-face) + :height 2.75 :background "gray90"))) + "Face used for types in the semantic overlay.") + +(defcustom minimap-width-fraction 0.15 + "Fraction of width which should be used for minimap sidebar." + :type 'number + :group 'minimap) + +(defcustom minimap-minimum-width 30 + "Minimum width of minimap in characters (default size). +Use nil to disable." + :type 'number + :group 'minimap) + +(defcustom minimap-window-location 'left + "Location of the minimap window. +Can be either the symbol `left' or `right'." + :type '(choice (const :tag "Left" left) + (const :tag "Right" right)) + :group 'minimap) + +(defcustom minimap-buffer-name " *MINIMAP*" + "Buffer name of minimap sidebar." + :type 'string + :group 'minimap) + +(defcustom minimap-update-delay 0.1 + "Delay in seconds after which sidebar gets updated. +Setting this to 0 will let the minimap react immediately, but +this will slow down scrolling." + :type 'number + :set (lambda (sym value) + (set sym value) + (when (and (boundp 'minimap-timer-object) + minimap-timer-object) + (cancel-timer minimap-timer-object) + (setq minimap-timer-object + (run-with-idle-timer + minimap-update-delay t 'minimap-update)))) + :group 'minimap) + +(defcustom minimap-always-recenter nil + "Whether minimap sidebar should be recentered after every point movement." + :type 'boolean + :group 'minimap) + +(defcustom minimap-recenter-type 'relative + "Specifies the type of recentering the minimap should use. +The minimap can use different types of recentering, i.e., how the +minimap should behave when you scroll in the main window or when +you drag the active region with the mouse. The following +explanations will probably not help much, so simply try them and +choose the one which suits you best. + +`relative' -- The position of the active region in the minimap +corresponds with the relative position of this region in the +buffer. This the default. + +`middle' -- The active region will stay fixed in the middle of +the minimap. + +`free' -- The position will be more or less free. When dragging +the active region, the minimap will scroll when you reach the +bottom or top." + :type '(choice (const :tag "Relative" relative) + (const :tag "Middle" middle) + (const :tag "Free" free)) + :group 'minimap) + +(defcustom minimap-hide-scroll-bar t + "Whether the minimap should hide the vertical scrollbar." + :type 'boolean + :group 'minimap) + +(defcustom minimap-hide-fringes nil + "Whether the minimap should hide the fringes." + :type 'boolean + :group 'minimap) + +(defcustom minimap-dedicated-window t + "Whether the minimap should create a dedicated window." + :type 'boolean + :group 'minimap) + +(defcustom minimap-display-semantic-overlays t + "Display overlays from CEDET's semantic analyzer. +If you use CEDET and the buffer's major-mode is supported, the +minimap can display overlays generated by the semantic analyzer. +By default, it will apply the faces `minimap-semantic-<X>-face', +with <X> being \"function\", \"variable\" and \"type\". Also, it +will display the name of the tag in the middle of the overlay in +the corresponding font-lock face. + +See also `minimap-enlarge-certain-faces', which can be used as +fallback." + :type 'boolean + :group 'minimap) + +(defcustom minimap-enlarge-certain-faces 'as-fallback + "Whether certain faces should be enlarged in the minimap. +All faces listed in `minimap-normal-height-faces' will be +displayed using the default font height, allowing you to still +read text using those faces. By default, this should enlarge all +function names in the minimap, given you have font locking +enabled. This variable can have the following values: + +'as-fallback (the default) -- The feature will only be activated + if information from CEDET's semantic analyzer isn't available + (see: `minimap-display-semantic-overlays'). +'always -- Always active. +nil -- Inactive." + :type '(choice (const :tag "Fallback if CEDET unavailable." as-fallback) + (const :tag "Always active." always) + (const :tag "Inactive." nil)) + :group 'minimap) + +(defcustom minimap-normal-height-faces '(font-lock-function-name-face) + "List of faces which should be displayed with normal height. +When `minimap-enlarge-certain-faces' is non-nil, all faces in +this list will be displayed using the default font height. By +default, this list contains `font-lock-function-name-face', so +you can still read function names in the minimap." + :type '(repeat face) + :group 'minimap) + +(defcustom minimap-sync-overlay-properties '(face invisible) + "Specifies which overlay properties should be synced. +Unlike text properties, overlays are not applied automatically to +the minimap and must be explicitly synced. This variable +specifies which overlay properties should be synced by +`minimap-sync-overlays'. Most importantly, this variable should +include 'invisible', so that hidden text does not appear in the +minimap buffer." + :type '(repeat symbol) + :group 'minimap) + +(defcustom minimap-major-modes '(prog-mode) + "Major modes for which a minimap should be created. +This can also be a parent mode like 'prog-mode. +If nil, a minimap must be explicitly created for each buffer." + :type '(repeat symbol) + :group 'minimap) + +(defcustom minimap-recreate-window t + "Whether the minimap window should be automatically re-created. +If this is non-nil, the side window for the minimap will be +automatically re-created as soon as you kill it." + :type 'boolean + :group 'minimap) + +(defcustom minimap-automatically-delete-window 'visible + "Whether the minimap window should be automatically deleted. +You can choose between three different behaviors here: If this is +`nil', the minimap window will never be automatically deleted. If +this is set to symbol 'visible, the minimap stays active as long +as the minimap's buffer is visible somewhere in the frame, +whether it is active or not. Any other value will delete the +minimap window as soon as you enter a buffer which is not derived +from `minimap-major-modes' (excluding the minibuffer)." + :type '(choice (const :tag "Never delete automatically" nil) + (const :tag "Keep as long as buffer visible" visible) + (const :tag "Delete when entering unsupported buffer" t)) + :group 'minimap) + +(defcustom minimap-tag-only nil + "Whether the minimap should only display parsed tags from CEDET." + :type 'boolean + :group 'minimap) + +(defcustom minimap-highlight-line t + "Whether the minimap should highlight the current line." + :type 'boolean + :group 'minimap) + +(defcustom minimap-disable-mode-line t + "Whether to disable the mode-line in the minimap window." + :type 'boolen + :group 'minimap) + +(defcustom minimap-hide-cursor t + "Whether to hide the cursor in the minimap window." + :type 'boolen + :group 'minimap) + +;;; Internal variables + +;; The buffer currently displayed in the minimap +(defvar minimap-active-buffer nil) +;; Window start/end from the base buffer +(defvar minimap-start nil) +(defvar minimap-end nil) +;; General overlay for the minimap +(defvar minimap-base-overlay nil) +;; Overlay for the active region +(defvar minimap-active-overlay nil) +;; Timer +(defvar minimap-timer-object nil) +;; Lines the minimap can display +(defvar minimap-numlines nil) +(defvar minimap-pointmin-overlay nil) +;; Line overlay +(defvar minimap-line-overlay nil) + + +;;; Helpers + +(defun minimap-active-current-buffer-p () + "Whether the current buffer is displayed in the minimap." + (and (eq (current-buffer) minimap-active-buffer) + (get-buffer minimap-buffer-name) + (with-current-buffer minimap-buffer-name + (eq minimap-active-buffer (buffer-base-buffer))))) + +(defsubst minimap-get-window () + "Get current minimap window." + (when (get-buffer minimap-buffer-name) + (get-buffer-window minimap-buffer-name))) + +(defsubst minimap-kill-buffer () + "Kill the minimap buffer." + (when (get-buffer minimap-buffer-name) + (kill-buffer minimap-buffer-name))) + +(defun minimap-create-window () + (let ((width (round (* (window-width) + minimap-width-fraction))) + buffer-window) + (when (< width minimap-minimum-width) + (setq width minimap-minimum-width)) + (if (eq minimap-window-location 'left) + ;; The existing window becomes the minimap + (progn + (setq buffer-window (split-window-horizontally width)) + ;; Restore prev/next buffers in the new window + (set-window-next-buffers buffer-window + (window-next-buffers)) + (set-window-prev-buffers buffer-window + (window-prev-buffers))) + ;; The new window is the minimap + (setq buffer-window (selected-window)) + (select-window (split-window-horizontally + (* -1 width)))) + ;; Set up the minimap window: + ;; You should not be able to enter the minimap window. + (set-window-parameter nil 'no-other-window t) + ;; Switch to buffer. + (switch-to-buffer + (get-buffer-create minimap-buffer-name) t t) + ;; Do not fold lines in the minimap. + (setq truncate-lines t) + ;; Make it dedicated. + (when minimap-dedicated-window + (set-window-dedicated-p nil t)) + ;; Return minimap window, but make sure we select the window where + ;; the buffer is in. + (prog1 + (selected-window) + (select-window buffer-window)))) + +(defun minimap-setup-hooks (&optional remove) + "Hook minimap into other modes. +If REMOVE is non-nil, remove minimap from other modes." + (if remove + (progn + (remove-hook 'outline-view-change-hook 'minimap-sync-overlays) + (remove-hook 'hs-hide-hook 'minimap-sync-overlays) + (remove-hook 'hs-show-hook 'minimap-sync-overlays) + (remove-hook 'flycheck-after-syntax-check-hook 'minimap-sync-overlays)) + ;; outline-(minor-)mode + (add-hook 'outline-view-change-hook 'minimap-sync-overlays) + ;; hideshow + (add-hook 'hs-hide-hook 'minimap-sync-overlays) + (add-hook 'hs-show-hook 'minimap-sync-overlays) + (add-hook 'flycheck-after-syntax-check-hook 'minimap-sync-overlays))) + +;;; Minimap creation / killing + +;;;###autoload +(define-minor-mode minimap-mode + "Toggle minimap mode." + :global t + :group 'minimap + :lighter " MMap" + (if minimap-mode + (progn + (when (and minimap-major-modes + (apply 'derived-mode-p minimap-major-modes)) + (unless (minimap-get-window) + (minimap-create-window)) + ;; Create minimap. + (minimap-new-minimap)) + ;; Create timer. + (setq minimap-timer-object + (run-with-idle-timer minimap-update-delay t 'minimap-update)) + ;; Hook into other modes. + (minimap-setup-hooks)) + ;; Turn it off + (minimap-kill) + (minimap-setup-hooks t))) + +(defun minimap-create () + "Create a minimap sidebar." + (interactive) + (minimap-mode 1)) + +(defun minimap-new-minimap () + "Create new minimap BUFNAME for current buffer and window. +Re-use already existing minimap window if possible." + (interactive) + (let ((currentbuffer (current-buffer)) + (win (minimap-get-window)) + (indbuf (make-indirect-buffer (current-buffer) + (concat minimap-buffer-name "_temp"))) + (edges (window-pixel-edges))) + ;; Remember the active buffer currently displayed in the minimap. + (setq minimap-active-buffer (current-buffer)) + ;; Hook into CEDET if necessary. + (when (and minimap-display-semantic-overlays + (boundp 'semantic-after-toplevel-cache-change-hook)) + (add-hook 'semantic-after-partial-cache-change-hook + 'minimap-apply-semantic-overlays nil t) + (add-hook 'semantic-after-toplevel-cache-change-hook + 'minimap-apply-semantic-overlays nil t)) + (with-selected-window win + ;; Now set up the minimap: + (when (window-dedicated-p) + (set-window-dedicated-p nil nil)) + (switch-to-buffer indbuf t t) + (minimap-kill-buffer) + (rename-buffer minimap-buffer-name) + ;; Do not fold lines in the minimap. + (setq truncate-lines t) + (when minimap-dedicated-window + (set-window-dedicated-p nil t)) + (setq minimap-base-overlay (make-overlay (point-min) (point-max) nil t t)) + (overlay-put minimap-base-overlay 'face 'minimap-font-face) + (overlay-put minimap-base-overlay 'priority 1) + ;; Add the hand mouse pointer to visible text. It doesn’t seem + ;; possible to set the mouse cursor when there’s no text. See + ;; `void-text-area-pointer'. + (overlay-put minimap-base-overlay 'pointer 'hand) + (when minimap-tag-only + (overlay-put minimap-base-overlay 'face + `(:inherit minimap-font-face + :foreground ,(face-background 'default)))) + (setq minimap-pointmin-overlay (make-overlay (point-min) (1+ (point-min)))) + (setq minimap-start (window-start) + minimap-end (window-end) + minimap-active-overlay (make-overlay minimap-start minimap-end) + line-spacing 0) + (overlay-put minimap-active-overlay 'face + 'minimap-active-region-background) + (when minimap-tag-only + (overlay-put minimap-active-overlay 'face + `(:inherit 'minimap-active-region-background + :foreground ,(face-background 'minimap-active-region-background)))) + (overlay-put minimap-active-overlay 'priority 5) + (minimap-sb-mode 1) + (when minimap-disable-mode-line + (setq mode-line-format nil)) + (when minimap-hide-cursor + (setq cursor-type nil)) + (when minimap-hide-scroll-bar + (setq vertical-scroll-bar nil) + (set-window-buffer nil (current-buffer))) + (when minimap-hide-fringes + (set-window-fringes nil 0 0)) + (when (and (boundp 'linum-mode) + linum-mode) + (linum-mode 0)) + (setq buffer-read-only t) + ;; Calculate the actual number of lines displayable with the minimap face. + (setq minimap-numlines + (floor + (/ + (- (nth 3 edges) (nth 1 edges)) + (car (progn (redisplay t) (window-line-height))))))) + (minimap-sync-overlays))) + +(defun minimap-kill () + "Kill minimap." + (interactive) + (when (minimap-get-window) + (delete-window (minimap-get-window))) + (cancel-timer minimap-timer-object)) + +;;; Minimap update + +(defun minimap-update (&optional force) + "Update minimap sidebar if necessary. +This is meant to be called from the idle-timer or the post command hook. +When FORCE, enforce update of the active region." + (interactive) + ;; If we are in the minibuffer, do nothing. + (unless (active-minibuffer-window) + (if (minimap-active-current-buffer-p) + ;; We are still in the same buffer, so just update the minimap. + (minimap-update-current-buffer force) + ;; The buffer was switched, check if the minimap should switch, too. + (if (and minimap-major-modes + (apply 'derived-mode-p minimap-major-modes)) + (progn + ;; Create window if necessary... + (unless (minimap-get-window) + (minimap-create-window)) + ;; ...and re-create minimap with new buffer... + (minimap-new-minimap) + ;; Redisplay + (sit-for 0) + ;; ...and call update again. + (minimap-update t)) + ;; We have entered a buffer for which no minimap should be + ;; displayed. Check if we should de + (when (and (minimap-get-window) + (minimap-need-to-delete-window)) + ;; We wait a tiny bit before deleting the window, since we + ;; might only be temporarily in another buffer. + (run-with-timer 0.3 nil + (lambda () + (when (and (null (minimap-active-current-buffer-p)) + (minimap-get-window)) + (delete-window (minimap-get-window)))))))))) + +(defun minimap-need-to-delete-window () + "Check if we should delete the minimap window. +This depends on `minimap-automatically-delete-window'." + (if (eq minimap-automatically-delete-window 'visible) + (null (get-buffer-window minimap-active-buffer)) + (null minimap-automatically-delete-window))) + +(defun minimap-update-current-buffer (force) + "Update minimap for the current buffer." + (let ((win (minimap-get-window)) + (start (window-start)) + (end (window-end)) + (pt (point))) + (when (and (null win) + minimap-recreate-window) + ;; The minimap window is no longer visible, so create it again... + (setq win (minimap-create-window)) + ;; ...and switch to existing minimap buffer. + (with-selected-window win + (when (window-dedicated-p) + (set-window-dedicated-p nil nil)) + (switch-to-buffer minimap-buffer-name t t) + (when minimap-hide-fringes + (set-window-fringes nil 0 0)) + (when minimap-dedicated-window + (set-window-dedicated-p nil t)))) + (with-selected-window win + ;; Make sure the base overlay spans the whole buffer. + (unless (and (= (overlay-start minimap-base-overlay) (point-min)) + (= (overlay-end minimap-base-overlay) (point-max))) + (move-overlay minimap-base-overlay (point-min) (point-max))) + (unless (and (not force) + (= minimap-start start) + (= minimap-end end)) + ;; Update the overlay. + (move-overlay minimap-active-overlay start end) + (setq minimap-start start + minimap-end end) + (minimap-recenter (line-number-at-pos (/ (+ end start) 2)) + (/ (- (line-number-at-pos end) + (line-number-at-pos start)) + 2))) + (goto-char pt) + (beginning-of-line) + (when minimap-highlight-line + (minimap-highlight-line)) + (when minimap-always-recenter + (recenter (round (/ (window-height) 2))))))) + +(defun minimap-highlight-line () + "Highlight current line in the minimap." + (unless minimap-line-overlay + (setq minimap-line-overlay (make-overlay (point) (1+ (point)) nil t)) + (overlay-put minimap-line-overlay 'priority 6)) + (overlay-put + minimap-line-overlay 'face + `(:background ,(face-background 'minimap-current-line-face) + :foreground ,(face-foreground 'minimap-current-line-face))) + (move-overlay minimap-line-overlay (point) (line-beginning-position 2))) + +;;; Overlay movement + +(defun minimap-move-overlay-mouse (start-event) + "Move overlay by tracking mouse movement." + (interactive "e") + (when (get-buffer-window (buffer-base-buffer (current-buffer))) + (let* ((echo-keystrokes 0) + (end-posn (event-end start-event)) + (start-point (posn-point end-posn)) + (make-cursor-line-fully-visible nil) + (cursor-type nil) + (minimap-automatically-delete-window nil) + (pcselmode (when (boundp 'pc-selection-mode) + pc-selection-mode)) + pt ev) + (when (and pcselmode (fboundp 'pc-selection-mode)) + (pc-selection-mode -1)) + (move-overlay minimap-active-overlay start-point minimap-end) + (track-mouse + (minimap-set-overlay start-point) + (while (and + (consp (setq ev (read-event))) + (eq (car ev) 'mouse-movement)) + (setq pt (posn-point (event-start ev))) + (when (numberp pt) + (with-selected-window (get-buffer-window minimap-buffer-name) + (goto-char pt) + (beginning-of-line) + (minimap-set-overlay (point)))))) + (minimap-update) + (when (and pcselmode (fboundp 'pc-selection-mode)) + (pc-selection-mode 1))))) + +(defun minimap-set-overlay (pt) + "Set overlay position, with PT being the middle." + (goto-char pt) + (let* ((ovstartline (line-number-at-pos minimap-start)) + (ovendline (line-number-at-pos minimap-end)) + (ovheight (round (/ (- ovendline ovstartline) 2))) + (line (line-number-at-pos)) + (winstart (window-start)) + (winend (window-end)) + newstart newend) + (setq pt (point-at-bol)) + (setq newstart (minimap-line-to-pos (- line ovheight))) + ;; Perform recentering + (minimap-recenter line ovheight) + ;; Set new position in main buffer and redisplay + (with-selected-window (get-buffer-window (buffer-base-buffer)) + (goto-char pt) + (set-window-start nil newstart) + (redisplay t) + (setq newend (window-end))) + (when (eq minimap-recenter-type 'free) + (while (> newend winend) + (scroll-up 5) + (redisplay t) + (setq winend (window-end)))) + (move-overlay minimap-active-overlay newstart newend))) + +(defun minimap-line-to-pos (line) + "Return point position of line number LINE." + (save-excursion + (goto-char 1) + (if (eq selective-display t) + (re-search-forward "[\n\C-m]" nil 'end (1- line)) + (forward-line (1- line))) + (point))) + +(defun minimap-recenter (middle height) + "Recenter the minimap according to `minimap-recenter-type'. +MIDDLE is the line number in the middle of the active region. +HEIGHT is the number of lines from MIDDLE to begin/end of the +active region." + (cond + ;; Relative recentering + ((eq minimap-recenter-type 'relative) + (let* ((maxlines (line-number-at-pos (point-max))) + percentage relpos newline start numlines) + (setq numlines (count-lines (window-start) (window-end))) + (setq percentage (/ (float middle) (float maxlines))) + (setq newline (ceiling (* percentage numlines))) + (setq start (minimap-line-to-pos + (- middle height + (floor (* percentage + (- numlines height height)))))) + (or (> start (point-min)) + (setq start (point-min))) + ;; If (point-max) already visible, don't go further + (if (and (> start (window-start)) + (with-selected-window (get-buffer-window (buffer-base-buffer)) + (= (point-max) (window-end)))) + (save-excursion + (goto-char (point-max)) + (recenter -1)) + (unless (and (> start (window-start)) + (= (point-max) (window-end))) + (set-window-start nil start))))) + ;; Middle recentering + ((eq minimap-recenter-type 'middle) + (let ((start (- middle height + (floor (* 0.5 + (- minimap-numlines height height)))))) + (if (< start 1) + (progn + ;; Hack: Emacs cannot scroll down any further, so we fake + ;; it using an overlay. Otherwise, the active region + ;; would move to the top. + (overlay-put minimap-pointmin-overlay + 'display (concat + (make-string (abs start) 10) + (buffer-substring (point-min) (1+ (point-min))))) + (overlay-put minimap-pointmin-overlay + 'face `(:background ,(face-background 'default))) + (overlay-put minimap-pointmin-overlay + 'priority 10) + (setq start 1)) + (overlay-put minimap-pointmin-overlay 'display "") + (overlay-put minimap-pointmin-overlay 'face nil)) + (set-window-start nil (minimap-line-to-pos start)))) + ;; Free recentering + ((eq minimap-recenter-type 'free) + (let ((newstart (minimap-line-to-pos (- middle height))) + (winstart (window-start))) + (while (< newstart winstart) + (scroll-down 5) + (redisplay t) + (setq winstart (window-start))))))) + +;;; Minimap minor mode + + (defvar minimap-sb-mode-map (make-sparse-keymap) + "Keymap used by `minimap-sb-mode'.") + +(define-key minimap-sb-mode-map [down-mouse-1] 'minimap-move-overlay-mouse) +(define-key minimap-sb-mode-map [down-mouse-2] 'minimap-move-overlay-mouse) +(define-key minimap-sb-mode-map [down-mouse-3] 'minimap-move-overlay-mouse) + +(define-minor-mode minimap-sb-mode + "Minor mode for minimap sidebar." + nil "minimap" minimap-sb-mode-map) + +;;; Sync minimap with modes which create/delete overlays. + +(defun minimap-sync-overlays () + "Synchronize overlays between base and minimap buffer. +Apply semantic overlays or face enlargement if necessary." + (interactive) + ;; Get overlays and Semantic status from base buffer. + (when (and minimap-mode + (minimap-active-current-buffer-p)) + (with-current-buffer minimap-active-buffer + (let ((baseov (overlays-in (point-min) (point-max))) + (semantic (and (boundp 'semantic-version) + (semantic-active-p))) + ov props p) + ;; Apply overlays to minimap. + (with-current-buffer minimap-buffer-name + ;; Delete overlays (but keep our own). + (let ((ovs (overlays-in (point-min) (point-max)))) + (dolist (ov ovs) + (unless (member ov (list minimap-pointmin-overlay + minimap-base-overlay + minimap-active-overlay)) + (delete-overlay ov)))) + (while baseov + (when (and (eq (overlay-buffer (car baseov)) minimap-active-buffer) + (setq props (minimap-get-sync-properties (car baseov)))) + (setq ov (make-overlay (overlay-start (car baseov)) + (overlay-end (car baseov)))) + (while (setq p (car props)) + (overlay-put ov (car p) (cadr p)) + (setq props (cdr props)))) + (setq baseov (cdr baseov))) + (move-overlay minimap-pointmin-overlay (point-min) (1+ (point-min))) + ;; Re-apply font overlay + (move-overlay minimap-base-overlay (point-min) (point-max))) + ;; Face enlargement + (when (and font-lock-mode + (or (eq minimap-enlarge-certain-faces 'always) + (and (eq minimap-enlarge-certain-faces 'as-fallback) + (or (not minimap-display-semantic-overlays) + (not semantic))))) + (when (eq font-lock-support-mode 'jit-lock-mode) + (condition-case nil + (jit-lock-fontify-now) + (error nil))) + (minimap-enlarge-faces)) + ;; Semantic overlays + (when (and semantic + minimap-display-semantic-overlays) + (minimap-apply-semantic-overlays t)))))) + +(defun minimap-get-sync-properties (ov) + "Get properties from overlay OV which should be synced. +You can specify those properties with +`minimap-sync-overlay-properties'." + (let ((syncprops minimap-sync-overlay-properties)) + (when minimap-tag-only + (setq syncprops (delq 'face syncprops))) + (delq nil + (mapcar + (lambda (p) + (let ((val (overlay-get ov p))) + (if val + (list p val) + nil))) + syncprops)))) + +(defun minimap-enlarge-faces () + "Apply default font to all faces in `minimap-normal-height-faces'." + (let ((pos (next-single-property-change (point-min) 'face)) + next ov face) + (while pos + (setq face (get-text-property pos 'face)) + (when (and face + (member face minimap-normal-height-faces)) + (with-current-buffer minimap-buffer-name + (setq ov + (make-overlay pos + (setq pos (next-single-property-change pos 'face)))) + (overlay-put ov 'face `(:family ,(face-font 'default))) + (overlay-put ov 'priority 5))) + (setq pos (next-single-property-change pos 'face))))) + +(defun minimap-apply-semantic-overlays (tags) + "Apply semantic overlays to the minimap. +TAGS is the list of tags. If it is t, fetch tags from buffer." + (when (and tags + minimap-mode) + (with-current-buffer minimap-active-buffer + (let (tag class ov ovnew) + (when (eq tags t) + (setq tags (semantic-fetch-tags))) + (while tags + (setq tag (car tags)) + (setq class (semantic-tag-class tag)) + (setq ov (semantic-tag-overlay tag)) + (when (and (overlayp ov) + (or (eq class 'function) + (eq class 'type) + (eq class 'variable))) + (with-current-buffer minimap-buffer-name + (let* ((start (overlay-start ov)) + (end (overlay-end ov)) + (name (semantic-tag-name tag)) + (lstart (line-number-at-pos start)) + (lend (line-number-at-pos end))) + ;; First, remove old Semantic overlays. + (remove-overlays start end 'minimap-semantic t) + (if minimap-tag-only + ;; Now put the new ones. + (overlay-put + (setq ovnew (make-overlay start end)) + 'face `(:background ,(face-background + (intern (format "minimap-semantic-%s-face" + (symbol-name class)))) + :foreground + ,(face-background + (intern (format "minimap-semantic-%s-face" + (symbol-name class)))) + )) + ;; Now put the new ones. + (overlay-put + (setq ovnew (make-overlay start end)) + 'face `(:background ,(face-background + (intern (format "minimap-semantic-%s-face" + (symbol-name class))))))) + (overlay-put ovnew 'priority 4) + (when (and (eq class 'function) + (> (- lend lstart) 5)) + (overlay-put ovnew 'priority 1) + (overlay-put ovnew 'minimap-semantic t) + (overlay-put (setq ovnew (make-overlay start (progn (goto-char start) (point-at-eol)))) + 'display (make-string 200 ?\u203E)) + (overlay-put ovnew 'minimap-semantic t) + (overlay-put ovnew 'face `(:foreground ,(face-foreground 'default) :overline nil)) + (overlay-put ovnew 'priority 8) + (overlay-put (setq ovnew (make-overlay (progn (goto-char end) (point-at-bol)) end)) + 'display (make-string 200 ?_)) + (overlay-put ovnew 'face `(:foreground ,(face-foreground 'default))) + (overlay-put ovnew 'minimap-semantic t) + (overlay-put ovnew 'priority 8)) + (setq start + (minimap-line-to-pos (/ (+ lstart lend) 2))) + (goto-char start) + (while (looking-at "^$") + (forward-line -1)) + (setq start (point)) + (setq end (progn (goto-char start) (point-at-eol))) + (setq ovnew (make-overlay start end)) + (overlay-put ovnew 'face (format "minimap-semantic-%s-face" + (symbol-name class))) + (overlay-put ovnew 'display (concat " " name " ")) + (overlay-put ovnew 'priority 7) + (overlay-put ovnew 'minimap-semantic t) + + + ))) + (setq tags (cdr tags))))))) + +(provide 'minimap) + +;;; minimap.el ends here |