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