cgit.sxemacs.org Git - packages/blob - xemacs-packages/edit-utils/highline.el

   1 ;; Copyright (C) 2000, 2001, 2002 Vinicius Jose Latorre
   2
   3 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
   4 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
   5 ;; Keywords: faces, frames, editing
   6 ;; Time-stamp: <2002/12/17 14:01:52 vinicius>
   7 ;; Version: 4.2
   8 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
   9
  10 ;; This file is *NOT* (yet?) part of GNU Emacs.
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30 ;;
  31 ;; Introduction
  32 ;; ------------
  33 ;;
  34 ;; This package is a minor mode to highlight the current line in buffer.
  35 ;;
  36 ;; highline was inspired on:
  37 ;;
  38 ;;    linemenu.el                 Bill Brodie <wbrodie@panix.com>
  39 ;;       Hook function to highlight current line in buffer.
  40 ;;
  41 ;;    hl-line.el                  Dave Love <fx@gnu.org>
  42 ;;       Highlight the current line.
  43 ;;
  44 ;;    highlight-current-line.el   Christoph Conrad <christoph.conrad@gmx.de>
  45 ;;       Highlight line where the cursor is.
  46 ;;
  47 ;; To use highline, insert in your ~/.emacs:
  48 ;;
  49 ;;    (require 'highline)
  50 ;;
  51 ;; For good performance, be sure to byte-compile highline.el, e.g.
  52 ;;
  53 ;;    M-x byte-compile-file <give the path to highline.el when prompted>
  54 ;;
  55 ;; This will generate highline.elc, which will be loaded instead of
  56 ;; highline.el.
  57 ;;
  58 ;; highline was tested with GNU Emacs 20.4.1.
  59 ;;
  60 ;;
  61 ;; Using highline
  62 ;; --------------
  63 ;;
  64 ;; * LOCAL highline (see NOTE 1 below):
  65 ;;    + To activate highline locally, type:
  66 ;;          M-x highline-on RET
  67 ;;       Or:
  68 ;;          C-u 1 M-x highline-local-mode RET
  69 ;;
  70 ;;    + To deactivate highline locally, type:
  71 ;;          M-x highline-off RET
  72 ;;       Or:
  73 ;;          C-u 0 M-x highline-local-mode RET
  74 ;;
  75 ;;    + To toggle highline locally, type:
  76 ;;          M-x highline-local-mode RET
  77 ;;
  78 ;; * GLOBAL highline (see NOTE 1 below):
  79 ;;    + To activate highline globally, type:
  80 ;;          M-x highline-mode-on RET
  81 ;;       Or:
  82 ;;          C-u 1 M-x highline-mode RET
  83 ;;
  84 ;;    + To deactivate highline globally, type:
  85 ;;          M-x highline-mode-off RET
  86 ;;       Or:
  87 ;;          C-u 0 M-x highline-mode RET
  88 ;;
  89 ;;    + To toggle highline globally, type:
  90 ;;          M-x highline-mode RET
  91 ;;
  92 ;; * INDIRECT highline (see NOTE 2 below):
  93 ;;    + To activate indirect highline, type:
  94 ;;          M-x highline-view-on RET
  95 ;;       Or:
  96 ;;          C-u 1 M-x highline-view-mode RET
  97 ;;
  98 ;;    + To deactivate indirect highline, type:
  99 ;;          M-x highline-view-off RET
 100 ;;       Or:
 101 ;;          C-u 0 M-x highline-view-mode RET
 102 ;;
 103 ;;    + To toggle indirect highline, type:
 104 ;;          M-x highline-view-mode RET
 105 ;;
 106 ;; * To customize highline, type:
 107 ;;       M-x highline-customize RET
 108 ;;
 109 ;; You can also bind `highline-local-mode', `highline-mode', `highline-on',
 110 ;; `highline-off', `highline-mode-on', `highline-mode-off',
 111 ;; `highline-customize', `highline-view-on', `highline-view-off' and
 112 ;; `highline-view-mode' to some key, like:
 113 ;;
 114 ;;    (global-set-key "\C-c\C-a"     'highline-on)
 115 ;;    (global-set-key "\C-c\C-b"     'highline-off)
 116 ;;    (global-set-key "\C-c\C-l"     'highline-local-mode)
 117 ;;    (global-set-key "\C-c\C-d"     'highline-mode-on)
 118 ;;    (global-set-key "\C-c\C-e"     'highline-mode-off)
 119 ;;    (global-set-key "\C-c\C-g"     'highline-mode)
 120 ;;    (global-set-key "\C-c\C-c"     'highline-customize)
 121 ;;    (global-set-key "\C-c\C-v\C-n" 'highline-view-on)
 122 ;;    (global-set-key "\C-c\C-v\C-f" 'highline-view-off)
 123 ;;    (global-set-key "\C-c\C-v\C-t" 'highline-view-mode)
 124 ;;
 125 ;; NOTE 1: There is no problem if you mix local and global minor mode usage.
 126 ;;
 127 ;; NOTE 2: Indirect highline (`highline-view-on', `highline-view-off' and
 128 ;;         `highline-view-mode') is useful when you wish to have various
 129 ;;         "visions" of the same buffer.
 130 ;;         Indirect highline uses an indirect buffer to get the "vision" of the
 131 ;;         buffer.  So, if you kill an indirect buffer, the base buffer is not
 132 ;;         affected; if you kill the base buffer, all indirect buffer related
 133 ;;         with the base buffer is automagicaly killed.  Also, any text
 134 ;;         insertion/deletion in any indirect or base buffer is updated in all
 135 ;;         related buffers.
 136 ;;
 137 ;;
 138 ;; Example
 139 ;; -------
 140 ;;
 141 ;; As an example, try to insert this in your .emacs file:
 142 ;;
 143 ;;  (require 'highline)
 144 ;;  ;; Turn on local highlighting for Dired (C-x d)
 145 ;;  (add-hook 'dired-after-readin-hook 'highline-on)
 146 ;;  ;; Turn on local highlighting for list-buffers (C-x C-b)
 147 ;;  (defadvice list-buffers (after highlight-line activate)
 148 ;;    (save-excursion
 149 ;;      (set-buffer "*Buffer List*")
 150 ;;      (highline-on)))
 151 ;;
 152 ;;
 153 ;; Hooks
 154 ;; -----
 155 ;;
 156 ;; highline has the following hook variables:
 157 ;;
 158 ;; `highline-hook'
 159 ;;    It is evaluated always when highline is turned on globally.
 160 ;;
 161 ;; `highline-local-hook'
 162 ;;    It is evaluated always when highline is turned on locally.
 163 ;;
 164 ;; `highline-view-hook'
 165 ;;    It is evaluated always when indirect highline is turned on.
 166 ;;
 167 ;; `highline-load-hook'
 168 ;;    It is evaluated after highline package is loaded.
 169 ;;
 170 ;;
 171 ;; Options
 172 ;; -------
 173 ;;
 174 ;; Below it's shown a brief description of highline options, please, see the
 175 ;; options declaration in the code for a long documentation.
 176 ;;
 177 ;; `highline-face'                      Specify face used to highlight the
 178 ;;                                      current line.
 179 ;;
 180 ;; `highline-vertical-face'             Specify face used to highlight other
 181 ;;                                      than current line.
 182 ;;
 183 ;; `highline-line'                      Specify which part of line should be
 184 ;;                                      highlighted.
 185 ;;
 186 ;; `highline-vertical'                  Specify how many vertical lines should
 187 ;;                                      be highlighted.
 188 ;;
 189 ;; `highline-verbose'                   Non-nil means generate messages.
 190 ;;
 191 ;; `highline-ignore-regexp'             Specify regexp for buffers to ignore.
 192 ;;
 193 ;; `highline-priority'                  Specify highline overlay priority.
 194 ;;
 195 ;; `highline-selected-window'           Non-nil means highlight current line on
 196 ;;                                      current window.
 197 ;;
 198 ;; To set the above options you may:
 199 ;;
 200 ;; a) insert the code in your ~/.emacs, like:
 201 ;;
 202 ;;       (setq highline-face 'highlight)
 203 ;;
 204 ;;    This way always keep your default settings when you enter a new Emacs
 205 ;;    session.
 206 ;;
 207 ;; b) or use `set-variable' in your Emacs session, like:
 208 ;;
 209 ;;       M-x set-variable RET highline-face RET highlight RET
 210 ;;
 211 ;;    This way keep your settings only during the current Emacs session.
 212 ;;
 213 ;; c) or use customization, for example:
 214 ;;       click on menu-bar *Help* option,
 215 ;;       then click on *Customize*,
 216 ;;       then click on *Browse Customization Groups*,
 217 ;;       expand *Editing* group,
 218 ;;       expand *Highline* group
 219 ;;       and then customize highline options.
 220 ;;    Through this way, you may choose if the settings are kept or not when
 221 ;;    you leave out the current Emacs session.
 222 ;;
 223 ;; d) or see the option value:
 224 ;;
 225 ;;       C-h v highline-face RET
 226 ;;
 227 ;;    and click the *customize* hypertext button.
 228 ;;    Through this way, you may choose if the settings are kept or not when
 229 ;;    you leave out the current Emacs session.
 230 ;;
 231 ;; e) or invoke:
 232 ;;
 233 ;;       M-x highline-customize RET
 234 ;;
 235 ;;    and then customize highline options.
 236 ;;    Through this way, you may choose if the settings are kept or not when
 237 ;;    you leave out the current Emacs session.
 238 ;;
 239 ;;
 240 ;; Acknowledgements
 241 ;; ----------------
 242 ;;
 243 ;; Thanks to Sandip Chitale <sandip.chitale@brokat.com> for byte-compilation
 244 ;; tests.
 245 ;;
 246 ;; Thanks to Stephan Engelke <engelke@gmx.ne> for XEmacs tests.
 247 ;;
 248 ;; Thanks to Roman Belenov <roman@nstl.nnov.ru> for `pre-command-hook'
 249 ;; suggestion.
 250 ;;
 251 ;; Thanks to Trey Jackson <bigfaceworm@hotmail.com> for `highline-line'
 252 ;; enhancements.
 253 ;;
 254 ;; Thanks to Fredrik Sundstroem <fresun-7@sm.luth.se> for permanent-local
 255 ;; overlay property indication.
 256 ;;
 257 ;; Thanks to:
 258 ;;    Bill Brodie <wbrodie@panix.com>              linemenu.el
 259 ;;    Dave Love <fx@gnu.org>                       hl-line.el
 260 ;;    Christoph Conrad <christoph.conrad@gmx.de>   highlight-current-line.el
 261 ;; And to all people who contributed with them.
 262 ;;
 263 ;;
 264 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 265
 266 ;;; Code:
 267
 268
 269 (eval-and-compile
 270   (cond
 271    ;; XEmacs
 272    ((let (case-fold-search)
 273       (string-match "XEmacs\\|Lucid\\|Epoch" emacs-version))
 274     ;; XEmacs needs overlay emulation package
 275     (or (require 'overlay)
 276         (error "`highline' requires `overlay' package."))
 277     (defun highline-alive-overlay (overlay-list)
 278       "Enforce that the car of OVERLAY-LIST isn't a deleted overlay."
 279       (when overlay-list
 280         (or (overlay-buffer (car overlay-list))
 281             (setcar overlay-list (make-overlay 1 1)))
 282         overlay-list))
 283     (defun highline-move-overlay (overlay start end)
 284       "Move overlay even if the overlay is deleted."
 285       (and (overlay-buffer overlay)
 286            (move-overlay overlay start end)))
 287     )
 288    ;; GNU Emacs
 289    (t
 290     (defalias 'highline-alive-overlay 'identity)
 291     (defalias 'highline-move-overlay  'move-overlay)
 292     )))
 293 \f
 294 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 295 ;; User Variables:
 296
 297
 298 ;;; Interface to the command system
 299
 300 (defgroup highline nil
 301   "Highlight the current line"
 302   :link '(emacs-library-link :tag "Source Lisp File" "highline.el")
 303   :group 'faces
 304   :group 'frames
 305   :group 'editing)
 306
 307
 308 (defcustom highline-face 'highline-face
 309   "*Specify face used to highlight the current line."
 310   :type 'face
 311   :group 'highline)
 312
 313
 314 (defface highline-face '((t (:background "paleturquoise")))
 315   "Face used to highlight current line.")
 316
 317
 318 (defcustom highline-vertical-face 'highline-vertical-face
 319   "*Specify face used to highlight other than current line.
 320
 321 See also `highline-vertical'."
 322   :type 'face
 323   :group 'highline)
 324
 325
 326 (defface highline-vertical-face '((t (:background "lightcyan")))
 327   "Face used to highlight other than current line.")
 328
 329
 330 (defcustom highline-line nil
 331   "*Specify which part of line should be highlighted.
 332
 333 Valid values are:
 334
 335    t                    mark up to end of line.
 336
 337    nil                  mark up to window border.  On XEmacs, it behaves as t.
 338                         NOTE: Let me know, if you find a way to mark up to
 339                               window border on XEmacs.
 340
 341    INTEGER              mark up from beginning of line to column INTEGER or to
 342                         end of line if INTEGER exceeds line length.  If INTEGER
 343                         is negative, the region marked starts from end of line
 344                         instead of beginning of line.
 345
 346    (LOWER . UPPER)      mark up the region from column LOWER to column UPPER or
 347                         to end of line if UPPER exceeds line length.  Nothing
 348                         happens if LOWER exceeds line length.
 349                         It must: 0 <= LOWER < UPPER.
 350
 351    (beyond . INTEGER)   mark up the region from column INTEGER to end of line.
 352                         Nothing happens if INTEGER exceeds line length.
 353                         It must: INTEGER > 0.
 354
 355    (point . INTEGER)    mark up the region from column
 356                         (- (current-column) INTEGER) to column
 357                         (+ (current-column) INTEGER).  It never goes beyond
 358                         beginning or end of line.
 359                         It must: INTEGER > 0.
 360
 361 Any other value is treated as t."
 362   :type '(choice :menu-tag "Mark Up To"
 363                  :tag "Mark Up To"
 364                  (const :tag "End Of Line" t)
 365                  (const :tag "Window Border" nil)
 366                  (integer :tag "Column")
 367                  (cons :tag "Point" :value (point . 0)
 368                        (const :tag "Point" point)
 369                        (integer :tag "To"))
 370                  (cons :tag "Beyond" :value (beyond . 0)
 371                        (const :tag "Beyond" beyond)
 372                        (integer :tag "From"))
 373                  (cons :tag "Range" :value (0 . 0)
 374                        (integer :tag "From")
 375                        (integer :tag "To")))
 376   :group 'highline)
 377
 378
 379 (defcustom highline-vertical nil
 380   "*Specify how many vertical lines should be highlighted.
 381
 382 Valid values are:
 383
 384    nil                  Highlight only current line.
 385
 386    t                    Highlight all current window.
 387
 388    (ABOVE . BELOW)      Highlight the vertical range from line
 389                         (current-line-number - ABOVE) to line
 390                         (current-line-number + BELOW).  ABOVE and BELOW should
 391                         be integers.  There are the following cases:
 392
 393                         1. ABOVE <= 0 and BELOW <= 0
 394                                 This is the same as nil, that is, only current
 395                                 line is highlighted.  It's recommended to set
 396                                 `highline-vertical' to nil instead of (0 . 0),
 397                                 it'll have a better performance.
 398
 399                         2. ABOVE <= 0 and BELOW > 0
 400                                 Only current line and lines below will be
 401                                 highlighted.
 402
 403                         3. ABOVE > 0 and BELOW <= 0
 404                                 Only current line and lines above will be
 405                                 highlighted.
 406
 407                         4. ABOVE > 0 and BELOW > 0
 408                                 Current line, lines above and lines below will
 409                                 be highlighted.
 410
 411 Any other value is treated as t."
 412   :type '(choice :menu-tag ""
 413                  :tag ""
 414                  (const :tag "Only Current Line" nil)
 415                  (const :tag "All Current Window" t)
 416                  (cons :tag "Vertical Range" :value (1 . 1)
 417                        (integer :tag "Above")
 418                        (integer :tag "Below")))
 419   :group 'highline)
 420
 421
 422 (defcustom highline-verbose t
 423   "*Non-nil means generate messages."
 424   :type 'boolean
 425   :group 'highline)
 426
 427
 428 (defcustom highline-ignore-regexp
 429   (concat "Faces\\|Colors\\|Minibuf\\|\\*tip\\*"
 430           ;; for example:
 431           ;; "\\|RMAIL.*summary\\|\\*Group\\|\\*Summary"
 432           )
 433   "*Specify regexp for buffers to ignore.
 434
 435 Set to nil or \"\", to accept any buffer.
 436
 437 Used by `highline-highlight-current-line'."
 438   :type 'regexp
 439   :group 'highline)
 440
 441
 442 (defcustom highline-priority 0
 443   "*Specify highline overlay priority.
 444
 445 Higher integer means higher priority, so highline overlay will have precedence
 446 over overlays with lower priority.  *Don't* use negative number."
 447   :type 'integer
 448   :group 'highline)
 449
 450
 451 (defcustom highline-selected-window nil
 452   "*Non-nil means highlight current line on current window.
 453
 454 This is useful when you have a buffer in two or more windows and wish to
 455 highlight only on current window."
 456   :type 'boolean
 457   :group 'highline)
 458
 459 \f
 460 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 461
 462
 463 ;; GNU Emacs
 464 (or (fboundp 'line-beginning-position)
 465     (defun line-beginning-position (&optional n)
 466       (save-excursion
 467         (and n (/= n 1) (forward-line (1- n)))
 468         (beginning-of-line)
 469         (point))))
 470
 471
 472 ;; GNU Emacs
 473 (or (fboundp 'line-end-position)
 474     (defun line-end-position (&optional n)
 475       (save-excursion
 476         (and n (/= n 1) (forward-line (1- n)))
 477         (end-of-line)
 478         (point))))
 479
 480 ;; GNU Emacs
 481 (defvar highlight-nonselected-window nil)
 482 (make-variable-buffer-local 'highlight-nonselected-window)
 483
 484 \f
 485 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 486 ;; Macros
 487
 488
 489 (defmacro highline-message (&rest body)
 490   `(and highline-verbose (interactive-p)
 491         (message ,@body)))
 492
 493
 494 (defmacro highline-minor-mode (arg mode on off message)
 495   `(progn
 496      (if (if arg
 497              (> (prefix-numeric-value arg) 0)
 498            (not ,mode))
 499          (,on)
 500        (,off))
 501      (highline-message ,message (if ,mode "on" "off"))))
 502
 503 \f
 504 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 505 ;; Customization
 506
 507
 508 ;;;###autoload
 509 (defun highline-customize ()
 510   "Customize highline group."
 511   (interactive)
 512   (customize-group 'highline))
 513
 514 \f
 515 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 516 ;; User commands
 517
 518
 519 (defvar highline-mode nil
 520   "Non-nil means highline global minor mode is enabled (HL on modeline).")
 521
 522
 523 (defvar highline-local-mode nil
 524   "Non-nil means highline local minor mode is enabled (hl on modeline).")
 525 (make-variable-buffer-local 'highline-local-mode)
 526
 527
 528 (defvar highline-view-mode nil
 529   "Non-nil means highline view minor mode is enabled (Ihl on modeline).")
 530 (make-variable-buffer-local 'highline-view-mode)
 531
 532
 533 (defvar highline-overlays nil
 534   "Overlay list to highlight line(s)")
 535 (make-variable-buffer-local 'highline-overlays)
 536
 537 (put 'highline-overlays 'permanent-local t)
 538
 539
 540 ;;;###autoload
 541 (defun highline-mode (&optional arg)
 542   "Toggle global minor mode to highlight line about point (HL on modeline).
 543
 544 With ARG, turn highline mode on if ARG is positive, off otherwise.
 545 Only useful with a windowing system."
 546   (interactive "P")
 547   (highline-minor-mode arg highline-mode
 548                        highline-mode-on highline-mode-off
 549                        "Highline global mode is %s"))
 550
 551
 552 ;;;###autoload
 553 (defun highline-mode-on ()
 554   "Turn on global minor mode to highlight line about point (HL on modeline)."
 555   (interactive)
 556   (save-excursion
 557     (let ((buffers (buffer-list))
 558           (temp (get-buffer-create (make-temp-name " *Temp"))))
 559       ;; be sure to access global `pre-command-hook' and `post-command-hook'
 560       (set-buffer temp)
 561       (setq highline-mode t)
 562       (add-hook 'mouse-leave-buffer-hook 'highline-unhighlight-current-line)
 563       (add-hook 'pre-command-hook 'highline-unhighlight-current-line)
 564       (add-hook 'post-command-hook 'highline-highlight-current-line)
 565       (add-hook 'window-scroll-functions 'highline-highlight-current-line)
 566       (while buffers                    ; adjust all local mode
 567         (set-buffer (car buffers))
 568         (unless highline-local-mode
 569           (add-hook 'pre-command-hook 'highline-unhighlight-current-line nil t)
 570           (add-hook 'post-command-hook 'highline-highlight-current-line nil t)
 571           (add-hook 'window-scroll-functions
 572                     'highline-highlight-current-line nil t)
 573           (highline-highlight-current-line))
 574         (setq buffers (cdr buffers)))
 575       (highline-highlight-current-line)
 576       (kill-buffer temp)))
 577   (run-hooks 'highline-hook)
 578   (highline-message "Highline global mode is on"))
 579
 580
 581 ;;;###autoload
 582 (defun highline-mode-off ()
 583   "Turn off global minor mode to highlight line about point (HL on modeline)."
 584   (interactive)
 585   (save-excursion
 586     (let ((buffers (buffer-list))
 587           (temp (get-buffer-create (make-temp-name " *Temp"))))
 588       ;; be sure to access global `pre-command-hook' and `post-command-hook'
 589       (set-buffer temp)
 590       (setq highline-mode nil)
 591       (remove-hook 'mouse-leave-buffer-hook 'highline-unhighlight-current-line)
 592       (remove-hook 'pre-command-hook 'highline-unhighlight-current-line)
 593       (remove-hook 'post-command-hook 'highline-highlight-current-line)
 594       (remove-hook 'window-scroll-functions 'highline-highlight-current-line)
 595       (while buffers                    ; adjust all local mode
 596         (set-buffer (car buffers))
 597         (unless highline-local-mode
 598           (remove-hook 'pre-command-hook 'highline-unhighlight-current-line t)
 599           (remove-hook 'post-command-hook 'highline-highlight-current-line t)
 600           (remove-hook 'window-scroll-functions
 601                        'highline-highlight-current-line t)
 602           (highline-unhighlight-current-line))
 603         (setq buffers (cdr buffers)))
 604       (kill-buffer temp)))
 605   (highline-message "Highline global mode is off"))
 606
 607
 608 ;;;###autoload
 609 (defun highline-local-mode (&optional arg)
 610   "Toggle local minor mode to highlight the line about point (hl on modeline).
 611
 612 With ARG, turn highline mode on if ARG is positive, off otherwise.
 613 Only useful with a windowing system."
 614   (interactive "P")
 615   (highline-minor-mode arg highline-local-mode
 616                        highline-on highline-off
 617                        "Highline local mode is %s"))
 618
 619
 620 ;;;###autoload
 621 (defun highline-on ()
 622   "Turn on local highlighting of the current line in buffer (hl on modeline)."
 623   (interactive)
 624   (setq highline-local-mode t)
 625   (highline-local-on)
 626   (run-hooks 'highline-local-hook)
 627   (highline-message "Highline local mode is on"))
 628
 629
 630 ;;;###autoload
 631 (defun highline-off ()
 632   "Turn off local highlighting of the current line in buffer (hl on modeline)."
 633   (interactive)
 634   (setq highline-local-mode nil)
 635   (highline-local-off)
 636   (highline-message "Highline local mode is off"))
 637
 638
 639 ;;;###autoload
 640 (defun highline-view-mode (&optional arg)
 641   "Toggle indirect mode to highlight current line in buffer (Ihl on modeline).
 642
 643 With ARG, turn highline mode on if ARG is positive, off otherwise.
 644 Only useful with a windowing system.
 645
 646 Indirect highline (`highline-view-on', `highline-view-off' and
 647 `highline-view-mode') is useful when you wish to have various \"visions\" of
 648 the same buffer.
 649
 650 Indirect highline uses an indirect buffer to get the \"vision\" of the buffer.
 651 So, if you kill an indirect buffer, the base buffer is not affected; if you
 652 kill the base buffer, all indirect buffer related with the base buffer is
 653 automagicaly killed.  Also, any text insertion/deletion in any indirect or base
 654 buffer is updated in all related buffers.
 655
 656 See also `highline-selected-window'."
 657   (interactive "P")
 658   (highline-minor-mode arg highline-view-mode
 659                        highline-view-on highline-view-off
 660                        "Highline view mode is %s"))
 661
 662
 663 ;;;###autoload
 664 (defun highline-view-on ()
 665   "Turn on indirect highlightining current line in buffer (Ihl on modeline).
 666
 667 Indirect highline (`highline-view-on', `highline-view-off' and
 668 `highline-view-mode') is useful when you wish to have various \"visions\" of
 669 the same buffer.
 670
 671 Indirect highline uses an indirect buffer to get the \"vision\" of the buffer.
 672 So, if you kill an indirect buffer, the base buffer is not affected; if you
 673 kill the base buffer, all indirect buffer related with the base buffer is
 674 automagicaly killed.  Also, any text insertion/deletion in any indirect or base
 675 buffer is updated in all related buffers.
 676
 677 See also `highline-selected-window'."
 678   (interactive)
 679   (let* ((local-buffer-read-only buffer-read-only)
 680          (buffer (current-buffer))
 681          (name (generate-new-buffer-name
 682                 (concat "{"
 683                         (buffer-name (or (buffer-base-buffer buffer) buffer))
 684                         " View}"))))
 685     (switch-to-buffer (make-indirect-buffer buffer name))
 686     (setq buffer-read-only local-buffer-read-only))
 687   (setq highline-view-mode t)
 688   (highline-local-on)
 689   (run-hooks 'highline-view-hook)
 690   (highline-message "Highline view mode is on"))
 691
 692
 693 ;;;###autoload
 694 (defun highline-view-off ()
 695   "Turn off indirect highlightining current line in buffer (Ihl on modeline).
 696
 697 Indirect highline (`highline-view-on', `highline-view-off' and
 698 `highline-view-mode') is useful when you wish to have various \"visions\" of
 699 the same buffer.
 700
 701 Indirect highline uses an indirect buffer to get the \"vision\" of the buffer.
 702 So, if you kill an indirect buffer, the base buffer is not affected; if you
 703 kill the base buffer, all indirect buffer related with the base buffer is
 704 automagicaly killed.  Also, any text insertion/deletion in any indirect or base
 705 buffer is updated in all related buffers.
 706
 707 See also `highline-selected-window'."
 708   (interactive)
 709   (when highline-view-mode
 710     (setq highline-view-mode nil)
 711     (highline-local-off)
 712     (let* ((buffer (current-buffer))
 713            (base   (buffer-base-buffer buffer)))
 714       (when base
 715         (kill-buffer buffer)
 716         (switch-to-buffer base)))
 717     (highline-message "Highline view mode is off")))
 718
 719 \f
 720 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 721 ;; Internal functions
 722
 723
 724 (defun highline-local-on ()
 725   (add-hook 'mouse-leave-buffer-hook 'highline-unhighlight-current-line)
 726   (add-hook (make-local-variable 'pre-command-hook)
 727             'highline-unhighlight-current-line nil t)
 728   (add-hook (make-local-variable 'post-command-hook)
 729             'highline-highlight-current-line nil t)
 730   (add-hook (make-local-variable 'window-scroll-functions)
 731             'highline-highlight-current-line nil t)
 732   (highline-highlight-current-line))
 733
 734
 735 (defun highline-local-off ()
 736   (remove-hook 'mouse-leave-buffer-hook 'highline-unhighlight-current-line)
 737   (remove-hook 'pre-command-hook 'highline-unhighlight-current-line t)
 738   (remove-hook 'post-command-hook 'highline-highlight-current-line t)
 739   (remove-hook 'window-scroll-functions 'highline-highlight-current-line t)
 740   (highline-unhighlight-current-line))
 741
 742
 743 (defsubst highline-column-position (column)
 744   (save-excursion
 745     (move-to-column (max 0 column))
 746     (point)))
 747
 748
 749 (defun highline-unhighlight-current-line (&rest ignore)
 750   "Unhighlight current line."
 751   (let ((overs highline-overlays))
 752     (while (and overs
 753                 (overlay-end (car overs))
 754                 (> (overlay-end (car overs)) 1))
 755       (highline-move-overlay (car overs) 1 1)
 756       (setq overs (cdr overs)))))
 757
 758
 759 (defun highline-highlight-current-line (&rest ignore)
 760   "Highlight current line."
 761   (unless (and highline-ignore-regexp
 762                (not (equal "" highline-ignore-regexp))
 763                (string-match highline-ignore-regexp (buffer-name)))
 764     (setq highlight-nonselected-window (not highline-selected-window))
 765     (save-excursion
 766       (let* ((column       (current-column))
 767              (overs        highline-overlays)
 768              (lines        (highline-vertical))
 769              (current-line (cdr lines)))
 770         (setq lines (car lines))
 771         (while (let ((ov (car (or (highline-alive-overlay overs)
 772                                   (setq highline-overlays
 773                                         (cons (make-overlay 1 1) ; hide it
 774                                               highline-overlays)))))
 775                      pointp rangep beyondp)
 776                  (setq overs (cdr overs))
 777                  ;; set current overlay properties
 778                  (overlay-put ov 'hilit t)
 779                  (overlay-put ov 'face (if (= lines current-line)
 780                                            highline-face
 781                                          highline-vertical-face))
 782                  (overlay-put ov 'priority highline-priority)
 783                  (and highline-selected-window
 784                       (overlay-put ov 'window (selected-window)))
 785                  ;; move highlight to the current line
 786                  (and (consp highline-line)
 787                       (integerp (cdr highline-line))
 788                       (> (cdr highline-line) 0)
 789                       (or (setq beyondp (eq (car highline-line) 'beyond))
 790                           (setq pointp  (eq (car highline-line) 'point))
 791                           (setq rangep  (and (integerp (car highline-line))
 792                                              (>= (car highline-line) 0)
 793                                              (< (car highline-line)
 794                                                 (cdr highline-line))))))
 795                  (move-overlay
 796                   ;; overlay
 797                   ov
 798                   ;; start point
 799                   (cond (rangep         ; (LOWER . UPPER)
 800                          (highline-column-position (car highline-line)))
 801                         (beyondp        ; (beyond . INTEGER)
 802                          (highline-column-position (cdr highline-line)))
 803                         (pointp         ; (point . INTEGER)
 804                          (highline-column-position
 805                           (- column (cdr highline-line))))
 806                         ((integerp highline-line) ; INTEGER
 807                          (if (>= highline-line 0)
 808                              (line-beginning-position)
 809                            (line-end-position)))
 810                         ((line-beginning-position))) ; t or nil
 811                   ;; end point
 812                   (cond (rangep         ; (LOWER . UPPER)
 813                          (highline-column-position (cdr highline-line)))
 814                         (pointp         ; (point . INTEGER)
 815                          (highline-column-position
 816                           (+ column (cdr highline-line))))
 817                         ((integerp highline-line) ; INTEGER
 818                          (highline-column-position
 819                           (if (>= highline-line 0)
 820                               highline-line
 821                             (save-excursion
 822                               (end-of-line)
 823                               (+ column highline-line)))))
 824                         (highline-line  ; t or (beyond . INTEGER)
 825                          (line-end-position))
 826                         ((min (point-max) ; nil
 827                               (1+ (line-end-position))))))
 828                  ;; while condition
 829                  (> (setq lines (1- lines)) 0))
 830           ;; while body
 831           (forward-line 1))
 832         ;; unhighlight remainding overlays, if any
 833         (while (and overs (> (overlay-end (car overs)) 1))
 834           (highline-move-overlay (car overs) 1 1)
 835           (setq overs (cdr overs)))))))
 836
 837
 838 (defun highline-vertical ()
 839   (cond
 840    ;; nil - only current line
 841    ((null highline-vertical)
 842     '(1 . 1))
 843    ;; (ABOVE . BELOW) - vertical range
 844    ((and (consp highline-vertical)
 845          (let ((above (car highline-vertical))
 846                (below (cdr highline-vertical)))
 847            (and (integerp above)
 848                 (integerp below)
 849                 (let ((below (1+ (max below 0))))
 850                   (cons (if (<= above 0)
 851                             below
 852                           (forward-line (- above))
 853                           (+ above below))
 854                         below))))))
 855    ;; t - all current window
 856    (t
 857     (let ((height (window-height))
 858           (start  (window-start)))
 859       (prog1
 860           (cons (1- height)
 861                 (- height
 862                    (count-lines start (point))
 863                    (if (zerop (current-column)) 1 0)))
 864         (goto-char start))))
 865    ))
 866
 867 \f
 868 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 869
 870
 871 (add-to-list 'minor-mode-alist '(highline-mode " HL"))
 872 (add-to-list 'minor-mode-alist '(highline-local-mode " hl"))
 873 (add-to-list 'minor-mode-alist '(highline-view-mode " Ihl"))
 874
 875
 876 (provide 'highline)
 877
 878
 879 (run-hooks 'highline-load-hook)
 880
 881
 882 ;;; highline.el ends here