code.delx.au - gnu-emacs-elpa/blob - packages/minimap/minimap.el

   1 ;;; minimap.el --- Sidebar showing a "mini-map" of a buffer
   2
   3 ;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: David Engster <deng@randomsample.de>
   6 ;; Keywords:
   7 ;; Version: 1.1
   8
   9 ;; This file is part of GNU Emacs.
  10
  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.
  15 ;;
  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.
  20 ;;
  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/>.
  23
  24 ;;; Commentary:
  25
  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
  31 ;; edit buffer.  Additionally, you can overlay information from the
  32 ;; tags gathered by CEDET's semantic analyzer.
  33
  34 ;; Simply use M-x minimap-mode to toggle activation of the minimap.
  35 ;; Use 'M-x customize-group RET minimap RET' to adapt minimap to your
  36 ;; needs.
  37
  38 ;;; KNOWN BUGS:
  39
  40 ;; * Currently cannot deal with images.
  41 ;; * Display/movement can be a bit erratic at times.
  42
  43 ;;; TODO:
  44
  45 ;; * Fix known bugs.
  46 ;; * Make sidebar permanently visible. This requires something like a
  47 ;;   'window group' feature in Emacs, which is currently being worked on.
  48 ;; * Moving the active region with the keyboard / mouse-wheel ?
  49
  50
  51 ;;; News:
  52
  53 ;;;; Changes since v1.0:
  54 ;;
  55 ;; - Largely rewritten as a minor mode; use M-x minimap-mode to
  56 ;;   enable/disable.
  57 ;; - Minimap will now remain active for all buffers which derive from
  58 ;;   `prog-mode' (can be changed through `minimap-major-modes').  The
  59 ;;   minimap window will be automatically created or deleted (see new
  60 ;;   variables `minimap-recreate-window' and
  61 ;;   `minimap-automatically-delete-window').
  62 ;; - Possibility to set a minimum width of the minimap window
  63 ;;   (`minimap-minimum-width').
  64 ;; - Minimap window will be marked so that you should not be able to
  65 ;;   enter it.
  66 ;; - Semantic overlays will be automatically updated during editing.
  67 ;; - Lots of bug fixes.
  68
  69 ;;; Customizable variables:
  70
  71 (defgroup minimap nil
  72   "A minimap sidebar for Emacs."
  73   :group 'convenience)
  74
  75 (defface minimap-font-face
  76   '((default :family "DejaVu Sans Mono" :height 30))
  77   "Face used for text in minimap buffer, notably the font family and height.
  78 This height should be really small.  You probably want to use a
  79 TrueType font for this.  After changing this, you should
  80 recreate the minimap to avoid problems with recentering."
  81   :group 'minimap)
  82
  83 (defface minimap-active-region-background
  84   '((((background dark)) (:background "#4517305D0000"))
  85     (t (:background "#C847D8FEFFFF")))
  86   "Face for the active region in the minimap.
  87 By default, this is only a different background color."
  88   :group 'minimap)
  89
  90 (defface minimap-semantic-function-face
  91   '((((background dark))
  92      (:box (:line-width 1 :color "white")
  93            :inherit (font-lock-function-name-face minimap-font-face)
  94            :height 2.75 :background "gray10"))
  95     (t (:box (:line-width 1 :color "black")
  96              :inherit (font-lock-function-name-face minimap-font-face)
  97              :height 2.75 :background "gray90")))
  98   "Face used for functions in the semantic overlay.")
  99
 100 (defface minimap-semantic-variable-face
 101   '((((background dark))
 102      (:box (:line-width 1 :color "white")
 103            :inherit (font-lock-variable-name-face minimap-font-face)
 104             :height 2.75 :background "gray10"))
 105     (t (:box (:line-width 1 :color "black")
 106              :inherit (font-lock-function-name-face minimap-font-face)
 107              :height 2.75 :background "gray90")))
 108   "Face used for variables in the semantic overlay.")
 109
 110 (defface minimap-semantic-type-face
 111   '((((background dark))
 112      (:box (:line-width 1 :color "white")
 113            :inherit (font-lock-type-face minimap-font-face)
 114            :height 2.75 :background "gray10"))
 115     (t (:box (:line-width 1 :color "black")
 116              :inherit (font-lock-function-name-face minimap-font-face)
 117              :height 2.75 :background "gray90")))
 118   "Face used for types in the semantic overlay.")
 119
 120 (defcustom minimap-width-fraction 0.15
 121   "Fraction of width which should be used for minimap sidebar."
 122   :type 'number
 123   :group 'minimap)
 124
 125 (defcustom minimap-minimum-width 30
 126   "Minimum width of minimap in characters (default size).
 127 Use nil to disable."
 128   :type 'number
 129   :group 'minimap)
 130
 131 (defcustom minimap-window-location 'left
 132   "Location of the minimap window.
 133 Can be either the symbol `left' or `right'."
 134   :type '(choice (const :tag "Left" left)
 135                  (const :tag "Right" right))
 136   :group 'minimap)
 137
 138 (defcustom minimap-buffer-name " *MINIMAP*"
 139   "Buffer name of minimap sidebar."
 140   :type 'string
 141   :group 'minimap)
 142
 143 (defcustom minimap-update-delay 0.2
 144   "Delay in seconds after which sidebar gets updated.
 145 Setting this to 0 will let the minimap react immediately, but
 146 this will slow down scrolling."
 147   :type 'number
 148   :set (lambda (sym value)
 149          (set sym value)
 150          (when (and (boundp 'minimap-timer-object)
 151                     minimap-timer-object)
 152            (cancel-timer minimap-timer-object)
 153            (setq minimap-timer-object
 154                  (run-with-idle-timer
 155                   minimap-update-delay t 'minimap-update))))
 156   :group 'minimap)
 157
 158 (defcustom minimap-always-recenter nil
 159   "Whether minimap sidebar should be recentered after every point movement."
 160   :type 'boolean
 161   :group 'minimap)
 162
 163 (defcustom minimap-recenter-type 'relative
 164   "Specifies the type of recentering the minimap should use.
 165 The minimap can use different types of recentering, i.e., how the
 166 minimap should behave when you scroll in the main window or when
 167 you drag the active region with the mouse.  The following
 168 explanations will probably not help much, so simply try them and
 169 choose the one which suits you best.
 170
 171 `relative' -- The position of the active region in the minimap
 172 corresponds with the relative position of this region in the
 173 buffer.  This the default.
 174
 175 `middle' -- The active region will stay fixed in the middle of
 176 the minimap.
 177
 178 `free' -- The position will be more or less free.  When dragging
 179 the active region, the minimap will scroll when you reach the
 180 bottom or top."
 181   :type '(choice (const :tag "Relative" relative)
 182                  (const :tag "Middle" middle)
 183                  (const :tag "Free" free))
 184   :group 'minimap)
 185
 186 (defcustom minimap-hide-scroll-bar t
 187   "Whether the minimap should hide the vertical scrollbar."
 188   :type 'boolean
 189   :group 'minimap)
 190
 191 (defcustom minimap-hide-fringes nil
 192   "Whether the minimap should hide the fringes."
 193   :type 'boolean
 194   :group 'minimap)
 195
 196 (defcustom minimap-dedicated-window t
 197   "Whether the minimap should create a dedicated window."
 198   :type 'boolean
 199   :group 'minimap)
 200
 201 (defcustom minimap-display-semantic-overlays t
 202   "Display overlays from CEDET's semantic analyzer.
 203 If you use CEDET and the buffer's major-mode is supported, the
 204 minimap can display overlays generated by the semantic analyzer.
 205 By default, it will apply the faces `minimap-semantic-<X>-face',
 206 with <X> being \"function\", \"variable\" and \"type\".  Also, it
 207 will display the name of the tag in the middle of the overlay in
 208 the corresponding font-lock face.
 209
 210 See also `minimap-enlarge-certain-faces', which can be used as
 211 fallback."
 212   :type 'boolean
 213   :group 'minimap)
 214
 215 (defcustom minimap-enlarge-certain-faces 'as-fallback
 216   "Whether certain faces should be enlarged in the minimap.
 217 All faces listed in `minimap-normal-height-faces' will be
 218 displayed using the default font height, allowing you to still
 219 read text using those faces.  By default, this should enlarge all
 220 function names in the minimap, given you have font locking
 221 enabled.  This variable can have the following values:
 222
 223 'as-fallback (the default) -- The feature will only be activated
 224   if information from CEDET's semantic analyzer isn't available
 225   (see: `minimap-display-semantic-overlays').
 226 'always -- Always active.
 227 nil -- Inactive."
 228   :type '(choice (const :tag "Fallback if CEDET unavailable." 'as-fallback)
 229                  (const :tag "Always active." 'always)
 230                  (const :tag "Inactive." nil))
 231   :group 'minimap)
 232
 233 (defcustom minimap-normal-height-faces '(font-lock-function-name-face)
 234   "List of faces which should be displayed with normal height.
 235 When `minimap-enlarge-certain-faces' is non-nil, all faces in
 236 this list will be displayed using the default font height.  By
 237 default, this list contains `font-lock-function-name-face', so
 238 you can still read function names in the minimap."
 239   :type '(repeat face)
 240   :group 'minimap)
 241
 242 (defcustom minimap-sync-overlay-properties '(face invisible)
 243   "Specifies which overlay properties should be synced.
 244 Unlike text properties, overlays are not applied automatically to
 245 the minimap and must be explicitly synced.  This variable
 246 specifies which overlay properties should be synced by
 247 `minimap-sync-overlays'.  Most importantly, this variable should
 248 include 'invisible', so that hidden text does not appear in the
 249 minimap buffer."
 250   :type '(repeat symbol)
 251   :group 'minimap)
 252
 253 (defcustom minimap-major-modes '(prog-mode)
 254   "Major modes for which a minimap should be created.
 255 This can also be a parent mode like 'prog-mode.
 256 If nil, a minimap must be explicitly created for each buffer."
 257   :type '(repeat symbol)
 258   :group 'minimap)
 259
 260 (defcustom minimap-recreate-window t
 261   "Whether the minimap window should be automatically re-created.
 262 If this is non-nil, the side window for the minimap will be
 263 automatically re-created as soon as you kill it."
 264   :type 'boolean
 265   :group 'minimap)
 266
 267 (defcustom minimap-automatically-delete-window t
 268   "Whether the minimap window should be automatically deleted.
 269 Setting this to non-nil will delete the minibuffer side window
 270 when you enter a buffer which is not derived from
 271 `minimap-major-modes' (excluding the minibuffer)."
 272   :type 'boolean
 273   :group 'minimap)
 274
 275 ;;; Internal variables
 276
 277 ;; The buffer currently displayed in the minimap
 278 (defvar minimap-active-buffer nil)
 279 ;; Window start/end from the base buffer
 280 (defvar minimap-start nil)
 281 (defvar minimap-end nil)
 282 ;; General overlay for the minimap
 283 (defvar minimap-base-overlay nil)
 284 ;; Overlay for the active region
 285 (defvar minimap-active-overlay nil)
 286 ;; Timer
 287 (defvar minimap-timer-object nil)
 288 ;; Lines the minimap can display
 289 (defvar minimap-numlines nil)
 290 (defvar minimap-pointmin-overlay nil)
 291
 292 ;;; Helpers
 293
 294 (defun minimap-active-current-buffer-p ()
 295   "Whether the current buffer is displayed in the minimap."
 296   (and (eq (current-buffer) minimap-active-buffer)
 297        (get-buffer minimap-buffer-name)
 298        (with-current-buffer minimap-buffer-name
 299          (eq minimap-active-buffer (buffer-base-buffer)))))
 300
 301 (defsubst minimap-get-window ()
 302   "Get current minimap window."
 303   (when (get-buffer minimap-buffer-name)
 304     (get-buffer-window minimap-buffer-name)))
 305
 306 (defsubst minimap-kill-buffer ()
 307   "Kill the minimap buffer."
 308   (when (get-buffer minimap-buffer-name)
 309     (kill-buffer minimap-buffer-name)))
 310
 311 (defun minimap-create-window ()
 312   (let ((width (round (* (window-width)
 313                          minimap-width-fraction))))
 314     (when (< width minimap-minimum-width)
 315       (setq width minimap-minimum-width))
 316     (if (eq minimap-window-location 'left)
 317         (split-window-horizontally width)
 318       (split-window-horizontally
 319        (* -1 width))
 320       (other-window 1))
 321     ;; Set up the minimap window:
 322     ;; You should not be able to enter the minimap window.
 323     (set-window-parameter nil 'no-other-window t)
 324     ;; Hide things.
 325     (when minimap-hide-scroll-bar
 326       (setq vertical-scroll-bar nil))
 327     (when minimap-hide-fringes
 328       (set-window-fringes nil 0 0))
 329     ;; Switch to buffer.
 330     (switch-to-buffer
 331      (get-buffer-create minimap-buffer-name) t t)
 332     ;; Do not fold lines in the minimap.
 333     (setq truncate-lines t)
 334     ;; Make it dedicated.
 335     (when minimap-dedicated-window
 336       (set-window-dedicated-p nil t))
 337     (prog1
 338         (selected-window)
 339       (other-window 1))))
 340
 341 (defun minimap-setup-hooks (&optional remove)
 342   "Hook minimap into other modes.
 343 If REMOVE is non-nil, remove minimap from other modes."
 344   (if remove
 345       (progn
 346         (remove-hook 'outline-view-change-hook 'minimap-sync-overlays)
 347         (remove-hook 'hs-hide-hook 'minimap-sync-overlays)
 348         (remove-hook 'hs-show-hook 'minimap-sync-overlays))
 349     ;; outline-(minor-)mode
 350     (add-hook 'outline-view-change-hook 'minimap-sync-overlays)
 351     ;; hideshow
 352     (add-hook 'hs-hide-hook 'minimap-sync-overlays)
 353     (add-hook 'hs-show-hook 'minimap-sync-overlays)))
 354
 355 ;;; Minimap creation / killing
 356
 357 (define-minor-mode minimap-mode
 358   "Toggle minimap mode."
 359   :global t
 360   :group 'minimap
 361   :lighter " MMap"
 362   (if minimap-mode
 363       (progn
 364         (when (and minimap-major-modes
 365                    (apply 'derived-mode-p minimap-major-modes))
 366           (unless (minimap-get-window)
 367             (minimap-create-window))
 368           ;; Create minimap.
 369           (minimap-new-minimap))
 370         ;; Create timer.
 371         (setq minimap-timer-object
 372               (run-with-idle-timer minimap-update-delay t 'minimap-update))
 373         ;; Hook into other modes.
 374         (minimap-setup-hooks))
 375     ;; Turn it off
 376     (minimap-kill)
 377     (minimap-setup-hooks t)))
 378
 379 ;;;###autoload
 380 (defun minimap-create ()
 381   "Create a minimap sidebar."
 382   (interactive)
 383   (minimap-mode 1))
 384
 385 (defun minimap-new-minimap ()
 386   "Create new minimap BUFNAME for current buffer and window.
 387 Re-use already existing minimap window if possible."
 388   (interactive)
 389   (let ((currentbuffer (current-buffer))
 390         (win (minimap-get-window))
 391         (indbuf (make-indirect-buffer (current-buffer)
 392                                       (concat minimap-buffer-name "_temp")))
 393         (edges (window-pixel-edges)))
 394     ;; Remember the active buffer currently displayed in the minimap.
 395     (setq minimap-active-buffer (current-buffer))
 396     ;; Hook into CEDET if necessary.
 397     (when (and minimap-display-semantic-overlays
 398                (boundp 'semantic-after-toplevel-cache-change-hook))
 399       (add-hook 'semantic-after-partial-cache-change-hook
 400                 'minimap-apply-semantic-overlays nil t)
 401       (add-hook 'semantic-after-toplevel-cache-change-hook
 402                 'minimap-apply-semantic-overlays nil t))
 403     (with-selected-window win
 404       ;; Now set up the minimap:
 405       (when (window-dedicated-p)
 406         (set-window-dedicated-p nil nil))
 407       (switch-to-buffer indbuf t t)
 408       (minimap-kill-buffer)
 409       (rename-buffer minimap-buffer-name)
 410       ;; Do not fold lines in the minimap.
 411       (setq truncate-lines t)
 412       (when minimap-dedicated-window
 413         (set-window-dedicated-p nil t))
 414       (setq minimap-base-overlay (make-overlay (point-min) (point-max) nil t t))
 415       (overlay-put minimap-base-overlay 'face 'minimap-font-face)
 416       (overlay-put minimap-base-overlay 'priority 1)
 417       (setq minimap-pointmin-overlay (make-overlay (point-min) (1+ (point-min))))
 418       (setq minimap-start (window-start)
 419             minimap-end (window-end)
 420             minimap-active-overlay (make-overlay minimap-start minimap-end)
 421             line-spacing 0)
 422       (overlay-put minimap-active-overlay 'face
 423                    'minimap-active-region-background)
 424       (overlay-put minimap-active-overlay 'priority 5)
 425       (minimap-sb-mode 1)
 426       (when (and (boundp 'linum-mode)
 427                  linum-mode)
 428         (linum-mode 0))
 429       (setq buffer-read-only t)
 430       ;; Calculate the actual number of lines displayable with the minimap face.
 431       (setq minimap-numlines
 432             (floor
 433              (/
 434               (- (nth 3 edges) (nth 1 edges))
 435               (car (progn (redisplay t) (window-line-height)))))))
 436     (minimap-sync-overlays)))
 437
 438 ;;;###autoload
 439 (defun minimap-kill ()
 440   "Kill minimap."
 441   (interactive)
 442   (when (minimap-get-window)
 443     (delete-window (minimap-get-window)))
 444   (cancel-timer minimap-timer-object))
 445
 446 ;;; Minimap update
 447
 448 (defun minimap-update (&optional force)
 449   "Update minimap sidebar if necessary.
 450 This is meant to be called from the idle-timer or the post command hook.
 451 When FORCE, enforce update of the active region."
 452   (interactive)
 453   ;; If we are in the minibuffer, do nothing.
 454   (unless (active-minibuffer-window)
 455     (if (minimap-active-current-buffer-p)
 456         ;; We are still in the same buffer, so just update the minimap.
 457         (let ((win (minimap-get-window))
 458               (start (window-start))
 459               (end (window-end))
 460               (pt (point)))
 461           (when (and (null win)
 462                      minimap-recreate-window)
 463             ;; The minimap window is no longer visible, so create it again...
 464             (setq win (minimap-create-window))
 465             ;; ...and switch to existing minimap buffer.
 466             (with-selected-window win
 467               (when (window-dedicated-p)
 468                 (set-window-dedicated-p nil nil))
 469               (switch-to-buffer minimap-buffer-name t t)
 470               (when minimap-dedicated-window
 471                 (set-window-dedicated-p nil t))))
 472           (with-selected-window win
 473             ;; Make sure the base overlay spans the whole buffer.
 474             (unless (and (= (overlay-start minimap-base-overlay) (point-min))
 475                          (= (overlay-end minimap-base-overlay) (point-max)))
 476               (move-overlay minimap-base-overlay (point-min) (point-max)))
 477             (unless (and (not force)
 478                          (= minimap-start start)
 479                          (= minimap-end end))
 480               ;; Update the overlay.
 481               (move-overlay minimap-active-overlay start end)
 482               (setq minimap-start start
 483                     minimap-end end)
 484               (minimap-recenter (line-number-at-pos (/ (+ end start) 2))
 485                                 (/ (- (line-number-at-pos end)
 486                                       (line-number-at-pos start))
 487                                    2)))
 488             (goto-char pt)
 489             (when minimap-always-recenter
 490               (recenter (round (/ (window-height) 2)))))
 491           ;; Redisplay
 492           (sit-for 0))
 493       ;; The buffer was switched, check if the minimap should switch, too.
 494       (if (and minimap-major-modes
 495                (apply 'derived-mode-p minimap-major-modes))
 496           (progn
 497             ;; Create window if necessary...
 498             (unless (minimap-get-window)
 499               (minimap-create-window))
 500             ;; ...and re-create minimap with new buffer...
 501             (minimap-new-minimap)
 502             ;; Redisplay
 503             (sit-for 0)
 504             ;; ...and call update again.
 505             (minimap-update t))
 506         ;; Otherwise, delete window if the user so wishes.
 507         (when (and (minimap-get-window)
 508                    minimap-automatically-delete-window)
 509           ;; We wait a tiny bit before deleting the window, since we
 510           ;; might only be temporarily in another buffer.
 511           (run-with-timer 0.3 nil
 512                           (lambda ()
 513                             (when (and (null (minimap-active-current-buffer-p))
 514                                        (minimap-get-window))
 515                               (delete-window (minimap-get-window))))))))))
 516
 517 ;;; Overlay movement
 518
 519 (defun minimap-move-overlay-mouse (start-event)
 520   "Move overlay by tracking mouse movement."
 521   (interactive "e")
 522   (mouse-set-point start-event)
 523   (when (get-buffer-window (buffer-base-buffer (current-buffer)))
 524     (let* ((echo-keystrokes 0)
 525            (end-posn (event-end start-event))
 526            (start-point (posn-point end-posn))
 527            (make-cursor-line-fully-visible nil)
 528            (cursor-type nil)
 529            (minimap-automatically-delete-window nil)
 530            (pcselmode (when (boundp 'pc-selection-mode)
 531                         pc-selection-mode))
 532            pt ev)
 533       (when (and pcselmode (fboundp 'pc-selection-mode))
 534         (pc-selection-mode -1))
 535       (move-overlay minimap-active-overlay start-point minimap-end)
 536       (track-mouse
 537         (minimap-set-overlay start-point)
 538         (while (and
 539                 (consp (setq ev (read-event)))
 540                 (eq (car ev) 'mouse-movement))
 541           (setq pt (posn-point (event-start ev)))
 542           (when (numberp pt)
 543             (minimap-set-overlay pt))))
 544       (select-window (get-buffer-window (buffer-base-buffer)))
 545       (minimap-update)
 546       (when (and pcselmode (fboundp 'pc-selection-mode))
 547         (pc-selection-mode 1)))))
 548
 549 (defun minimap-set-overlay (pt)
 550   "Set overlay position, with PT being the middle."
 551   (goto-char pt)
 552   (let* ((ovstartline (line-number-at-pos minimap-start))
 553          (ovendline (line-number-at-pos minimap-end))
 554          (ovheight (round (/ (- ovendline ovstartline) 2)))
 555          (line (line-number-at-pos))
 556          (winstart (window-start))
 557          (winend (window-end))
 558          newstart newend)
 559     (setq pt (point-at-bol))
 560     (setq newstart (minimap-line-to-pos (- line ovheight)))
 561     ;; Perform recentering
 562     (minimap-recenter line ovheight)
 563     ;; Set new position in main buffer and redisplay
 564     (with-selected-window (get-buffer-window (buffer-base-buffer))
 565       (goto-char pt)
 566       (set-window-start nil newstart)
 567       (redisplay t)
 568       (setq newend (window-end)))
 569     (when (eq minimap-recenter-type 'free)
 570       (while (> newend winend)
 571         (scroll-up 5)
 572         (redisplay t)
 573         (setq winend (window-end))))
 574     (move-overlay minimap-active-overlay newstart newend)))
 575
 576 (defun minimap-line-to-pos (line)
 577   "Return point position of line number LINE."
 578   (save-excursion
 579     (goto-char 1)
 580     (if (eq selective-display t)
 581         (re-search-forward "[\n\C-m]" nil 'end (1- line))
 582       (forward-line (1- line)))
 583     (point)))
 584
 585 (defun minimap-recenter (middle height)
 586   "Recenter the minimap according to `minimap-recenter-type'.
 587 MIDDLE is the line number in the middle of the active region.
 588 HEIGHT is the number of lines from MIDDLE to begin/end of the
 589 active region."
 590   (cond
 591    ;; Relative recentering
 592    ((eq minimap-recenter-type 'relative)
 593     (let* ((maxlines (line-number-at-pos (point-max)))
 594            percentage relpos newline start numlines)
 595       (setq numlines (count-lines (window-start) (window-end)))
 596       (setq percentage (/ (float middle) (float maxlines)))
 597       (setq newline (ceiling (* percentage numlines)))
 598       (setq start (minimap-line-to-pos
 599                    (- middle height
 600                       (floor (* percentage
 601                                 (- numlines height height))))))
 602       (or (> start (point-min))
 603           (setq start (point-min)))
 604       ;; If (point-max) already visible, don't go further
 605       (if (and (> start (window-start))
 606                (with-selected-window (get-buffer-window (buffer-base-buffer))
 607                  (= (point-max) (window-end))))
 608           (save-excursion
 609             (goto-char (point-max))
 610             (recenter -1))
 611         (unless (and (> start (window-start))
 612                      (= (point-max) (window-end)))
 613           (set-window-start nil start)))))
 614    ;; Middle recentering
 615     ((eq minimap-recenter-type 'middle)
 616      (let ((start (- middle height
 617                      (floor (* 0.5
 618                                (- minimap-numlines height height))))))
 619        (if (< start 1)
 620            (progn
 621              ;; Hack: Emacs cannot scroll down any further, so we fake
 622              ;; it using an overlay.  Otherwise, the active region
 623              ;; would move to the top.
 624              (overlay-put minimap-pointmin-overlay
 625                           'display (concat
 626                                     (make-string (abs start) 10)
 627                                     (buffer-substring (point-min) (1+ (point-min)))))
 628              (overlay-put minimap-pointmin-overlay
 629                           'face `(:background ,(face-background 'default)))
 630              (overlay-put minimap-pointmin-overlay
 631                           'priority 10)
 632              (setq start 1))
 633          (overlay-put minimap-pointmin-overlay 'display "")
 634          (overlay-put minimap-pointmin-overlay 'face nil))
 635        (set-window-start nil (minimap-line-to-pos start))))
 636     ;; Free recentering
 637     ((eq minimap-recenter-type 'free)
 638      (let ((newstart (minimap-line-to-pos (- middle height)))
 639            (winstart (window-start)))
 640        (while (< newstart winstart)
 641          (scroll-down 5)
 642          (redisplay t)
 643          (setq winstart (window-start)))))))
 644
 645 ;;; Minimap minor mode
 646
 647  (defvar minimap-sb-mode-map (make-sparse-keymap)
 648   "Keymap used by `minimap-sb-mode'.")
 649
 650 (define-key minimap-sb-mode-map [down-mouse-1] 'minimap-move-overlay-mouse)
 651 (define-key minimap-sb-mode-map [down-mouse-2] 'minimap-move-overlay-mouse)
 652 (define-key minimap-sb-mode-map [down-mouse-3] 'minimap-move-overlay-mouse)
 653
 654 (define-minor-mode minimap-sb-mode
 655   "Minor mode for minimap sidebar."
 656   nil "minimap" minimap-sb-mode-map)
 657
 658 ;;; Sync minimap with modes which create/delete overlays.
 659
 660 (defun minimap-sync-overlays ()
 661   "Synchronize overlays between base and minimap buffer.
 662 Apply semantic overlays or face enlargement if necessary."
 663   (interactive)
 664   ;; Get overlays and Semantic status from base buffer.
 665   (when (and minimap-mode
 666              (minimap-active-current-buffer-p))
 667     (with-current-buffer minimap-active-buffer
 668       (let ((baseov (overlays-in (point-min) (point-max)))
 669             (semantic (and (boundp 'semantic-version)
 670                            (semantic-active-p)))
 671             ov props p)
 672         ;; Apply overlays to minimap.
 673         (with-current-buffer minimap-buffer-name
 674           ;; Delete overlays (but keep our own).
 675           (let ((ovs (overlays-in (point-min) (point-max))))
 676             (dolist (ov ovs)
 677               (unless (member ov (list minimap-pointmin-overlay
 678                                        minimap-base-overlay
 679                                        minimap-active-overlay))
 680                 (delete-overlay ov))))
 681           (while baseov
 682             (when (and (eq (overlay-buffer (car baseov)) minimap-active-buffer)
 683                        (setq props (minimap-get-sync-properties (car baseov))))
 684               (setq ov (make-overlay (overlay-start (car baseov))
 685                                      (overlay-end (car baseov))))
 686               (while (setq p (car props))
 687                 (overlay-put ov (car p) (cadr p))
 688                 (setq props (cdr props))))
 689             (setq baseov (cdr baseov)))
 690           (move-overlay minimap-pointmin-overlay (point-min) (1+ (point-min)))
 691           ;; Re-apply font overlay
 692           (move-overlay minimap-base-overlay (point-min) (point-max)))
 693         ;; Face enlargement
 694         (when (and font-lock-mode
 695                    (or (eq minimap-enlarge-certain-faces 'always)
 696                        (and (eq minimap-enlarge-certain-faces 'as-fallback)
 697                             (or (not minimap-display-semantic-overlays)
 698                                 (not semantic)))))
 699           (when (eq font-lock-support-mode 'jit-lock-mode)
 700             (jit-lock-fontify-now))
 701           (minimap-enlarge-faces))
 702         ;; Semantic overlays
 703         (when (and semantic
 704                    minimap-display-semantic-overlays)
 705           (minimap-apply-semantic-overlays t))))))
 706
 707 (defun minimap-get-sync-properties (ov)
 708   "Get properties from overlay OV which should be synced.
 709 You can specify those properties with
 710 `minimap-sync-overlay-properties'."
 711   (delq nil
 712         (mapcar
 713          (lambda (p)
 714            (let ((val (overlay-get ov p)))
 715              (if val
 716                  (list p val)
 717                nil)))
 718          minimap-sync-overlay-properties)))
 719
 720 (defun minimap-enlarge-faces ()
 721   "Apply default font to all faces in `minimap-normal-height-faces'."
 722   (let ((pos (next-single-property-change (point-min) 'face))
 723         next ov face)
 724     (while pos
 725       (setq face (get-text-property pos 'face))
 726       (when (and face
 727                  (member face minimap-normal-height-faces))
 728         (with-current-buffer minimap-buffer-name
 729           (setq ov
 730                 (make-overlay pos
 731                               (setq pos (next-single-property-change pos 'face))))
 732           (overlay-put ov 'face `(:family ,(face-font 'default)))
 733           (overlay-put ov 'priority 5)))
 734       (setq pos (next-single-property-change pos 'face)))))
 735
 736 (defun minimap-apply-semantic-overlays (tags)
 737   "Apply semantic overlays to the minimap.
 738 TAGS is the list of tags.  If it is t, fetch tags from buffer."
 739   (when (and tags
 740              minimap-mode)
 741     (with-current-buffer minimap-active-buffer
 742       (let (tag class ov ovnew)
 743         (when (eq tags t)
 744           (setq tags (semantic-fetch-tags)))
 745         (while tags
 746           (setq tag (car tags))
 747           (setq class (semantic-tag-class tag))
 748           (setq ov (semantic-tag-overlay tag))
 749           (when (and (overlayp ov)
 750                      (or (eq class 'function)
 751                          (eq class 'type)
 752                          (eq class 'variable)))
 753             (with-current-buffer minimap-buffer-name
 754               (let ((start (overlay-start ov))
 755                     (end (overlay-end ov))
 756                     (name (semantic-tag-name tag)))
 757                 ;; First, remove old Semantic overlays.
 758                 (remove-overlays start end 'minimap-semantic t)
 759                 ;; Now put the new ones.
 760                 (overlay-put
 761                  (setq ovnew (make-overlay start end))
 762                  'face `(:background ,(face-background
 763                                        (intern (format "minimap-semantic-%s-face"
 764                                                        (symbol-name class))))))
 765                 (overlay-put ovnew 'priority 1)
 766                 (overlay-put ovnew 'minimap-semantic t)
 767                 (setq start
 768                       (minimap-line-to-pos (/ (+ (line-number-at-pos start)
 769                                                  (line-number-at-pos end)) 2)))
 770                 (goto-char start)
 771                 (while (looking-at "^$")
 772                   (forward-line -1))
 773                 (setq start (point))
 774                 (setq end (progn (goto-char start) (point-at-eol)))
 775                 (setq ovnew (make-overlay start end))
 776                 (overlay-put ovnew 'face (format "minimap-semantic-%s-face"
 777                                                  (symbol-name class)))
 778                 (overlay-put ovnew 'display (concat "  " name "  "))
 779                 (overlay-put ovnew 'priority 6)
 780                 (overlay-put ovnew 'minimap-semantic t))))
 781           (setq tags (cdr tags)))))))
 782
 783 (provide 'minimap)
 784
 785 ;;; minimap.el ends here