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

   1 ;;; on-screen.el --- guide your eyes while scrolling   -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2013-2015 Free Software Foundation, Inc
   4
   5 ;; Author: Michael Heerdegen <michael_heerdegen@web.de>
   6 ;; Maintainer: Michael Heerdegen <michael_heerdegen@web.de>
   7 ;; Created: 24 Jan 2013
   8 ;; Keywords: convenience
   9 ;; URL: https://github.com/michael-heerdegen/on-screen.el
  10 ;; Version: 1.3.2
  11 ;; Package-Requires: ((cl-lib "0"))
  12
  13
  14 ;; This file is not part of GNU Emacs.
  15
  16 ;; GNU Emacs is free software: you can redistribute it and/or modify
  17 ;; it under the terms of the GNU General Public License as published by
  18 ;; the Free Software Foundation, either version 3 of the License, or
  19 ;; (at your option) any later version.
  20
  21 ;; GNU Emacs is distributed in the hope that it will be useful,
  22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;; GNU General Public License for more details.
  25
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  28
  29
  30 ;;; Commentary:
  31
  32 ;; Scrolling can be distracting because your eyes may lose
  33 ;; orientation.  This library implements a minor mode that highlights
  34 ;; the previously visible buffer part after each scroll.
  35 ;;
  36 ;; Installation: Put this library somewhere in your load-path, or
  37 ;; install via M-x package-list-packages.  Then add to your init-file:
  38 ;;
  39 ;;   (require 'on-screen)
  40 ;;
  41 ;; To invoke on-screen globally for all buffers, also add
  42 ;;
  43 ;;   (on-screen-global-mode +1)
  44 ;;
  45 ;; Alternatively you can use the buffer local version `on-screen-mode'.
  46 ;; For example, add this line to your init file:
  47 ;;
  48 ;;   (add-hook 'Info-mode-hook 'on-screen-mode)
  49 ;;
  50 ;; to enable it in all Info buffers.
  51 ;;
  52 ;; By default, fringe markers are used for highlighting - see
  53 ;; `on-screen-highlight-method' to change that.  Type M-x
  54 ;; customize-group RET on-screen RET to see what else can be
  55 ;; configured.  If you use a configuration file (.emacs), you may also
  56 ;; want to define mode specific settings by using buffer local
  57 ;; variables.  For example, to use non intrusive fringe markers by
  58 ;; default, but transparent overlays in w3m, you would add
  59 ;;
  60 ;;   (add-hook
  61 ;;    'w3m-mode-hook
  62 ;;    (defun my-w3m-setup-on-screen ()
  63 ;;      (setq-local on-screen-highlight-method 'shadow)))
  64 ;;
  65 ;; to your .emacs.
  66 ;;
  67 ;; If you use transparent overlays for highlighting and there is the
  68 ;; library "hexrgb.el" in your `load-path', it will be used to compute
  69 ;; highlighting colors dynamically instead of using constant faces.
  70 ;; I.e. if you use non-default background colors (e.g. from custom
  71 ;; themes), on-screen will try to perform highlighting with a
  72 ;; suitable, slightly different color.  See
  73 ;; `on-screen-highlighting-to-background-delta' to control this.
  74 ;;
  75 ;;
  76 ;; Implementation notes (mainly for myself):
  77 ;;
  78 ;; Implementing this functionality is not as straightforward as one
  79 ;; might think.  There are commands that scroll other windows than the
  80 ;; current one.  Not only scrolling commands can scroll text - also
  81 ;; editing or even redisplay can cause windows to scroll.  There is
  82 ;; weird stuff such as folding and narrowing, influencing the visible
  83 ;; buffer part.  And although highlighting is realized in the
  84 ;; displayed buffers (with overlays), it must be organized on a
  85 ;; per-window basis, because different buffer parts may be displayed
  86 ;; in different windows, and their highlightings must not interfere.
  87 ;;
  88 ;; That all makes it necessary to observe windows via hacks in
  89 ;; different hooks, and to manage information about buffers, visible
  90 ;; parts and timers in a data structure (`on-screen-data').  It is
  91 ;; realized as an association list whose keys are windows.  There are
  92 ;; some pitfalls - e.g. the data can be out of date if the window
  93 ;; configuration has changed and windows display different buffers
  94 ;; now.  The data must be updated, but not simply be thrown away,
  95 ;; because the highlightings in the old buffers must be removed
  96 ;; nonetheless.
  97 ;;
  98 ;;
  99 ;; Acknowledgments:
 100 ;;
 101 ;; This library was inspired by a similar feature of the "Conqueror"
 102 ;; web browser.
 103 ;;
 104 ;; Thanks for Drew Adams for testing and contributions.
 105
 106
 107
 108
 109 ;;; Code:
 110
 111 ;;;; Requirements
 112
 113 (eval-when-compile
 114   (require 'cl-lib))
 115 (require 'timer)
 116 (require 'hexrgb nil t)
 117
 118 (declare-function hexrgb-saturation      "hexrgb")
 119 (declare-function hexrgb-approx-equal    "hexrgb")
 120 (declare-function hexrgb-increment-value "hexrgb")
 121 (declare-function hexrgb-increment-hue   "hexrgb")
 122
 123
 124 ;;;; Configuration stuff
 125
 126 (defgroup on-screen nil
 127   "Guide your eyes while scrolling."
 128   :group 'convenience
 129   :prefix "on-screen")
 130
 131 (defcustom on-screen-inverse-flag nil
 132   "What area to highlight.
 133 When nil, highlight the previously visible screenful.  Else
 134 highlight the previously off-screen parts."
 135   :type 'boolean)
 136
 137 (defcustom on-screen-highlight-method 'fringe
 138   "Type of highlighting used by `on-screen-mode'.
 139 The following values are valid:
 140
 141   fringe       - graphical markers in the fringe
 142   shadow       - transparent overlay on the text
 143   line         - transparent overlay on the confining text lines
 144   narrow-line  - narrow horizontal lines
 145
 146 The fringe and the narrow-line methods only work on graphical
 147 displays.  narrow-line only works with Emacs 24 or higher.
 148
 149 `on-screen-inverse-flag' defines which part(s) of the buffers are
 150 highlighted.
 151
 152 The face used for \"shadow\" and \"line\" may be computed
 153 dynamically to support different background colors (color themes)
 154 - see `on-screen-highlighting-to-background-delta'."
 155   :type '(choice
 156           (const :tag "Fringe markers"                     fringe)
 157           (const :tag "Transparent overlay"                shadow)
 158           (const :tag "Overlay on confining text lines"    line)
 159           (const :tag "Narrow horizontal line"             narrow-line)))
 160
 161 (defcustom on-screen-fringe-marker-position t
 162   "Where to display fringe markers.
 163 Ignored if highlighting doesn't use the fringe."
 164   :type '(choice
 165           (const :tag "Left fringe only"  left)
 166           (const :tag "Right fringe only" right)
 167           (const :tag "Both sides"        t)))
 168
 169 (defface on-screen-shadow
 170   '((((class color) (min-colors 88) (background light))
 171      :background "#f2efcb" ; alternative: "#f5f4ff" is a bit less intrusive
 172      )
 173     (((class color) (min-colors 88) (background dark))
 174      :background "#272620")
 175     (((class color) (min-colors 8)  (background light))
 176      :background "green")
 177     (((class color) (min-colors 8)  (background dark))
 178      :background "blue"))
 179   "Face used for displaying a transparent overlay.")
 180
 181 (defface on-screen-hl-line
 182   '((((background light)) :background "#ffa0a0")
 183     (((background dark))  :background "#300000"))
 184   "Face used for displaying the \"line\" style overlay.")
 185
 186 (defcustom on-screen-highlighting-to-background-delta .05
 187   "How much shadow and line highlighting should differ from background.
 188 This should be a positive floating point number less than 1.
 189 Smaller values will lead to a highlighting color being more
 190 similar to the frame background.  A value of nil means to use use
 191 just face `on-screen-shadow'.
 192
 193 This variable is ignored if the library \"hexrgb\" is not
 194 available."
 195   :type '(choice (const :tag "Use standard face" nil)
 196                  (float :tag "Delta")))
 197
 198 (defface on-screen-fringe '((t (:inherit shadow)))
 199   "Face used for fringe markers.")
 200
 201 (defface on-screen-narrow-line
 202   '((((background dark))  (:width extra-expanded :underline (:color "gray30" :style wave)))
 203     (((background light)) (:width extra-expanded :underline (:color "gray70" :style wave))))
 204   "Face used by the narrow-line highlighting method.")
 205
 206 (defcustom on-screen-delay 5
 207   "How long `on-screen-mode' should display optical aids."
 208   :type 'number)
 209
 210 (defcustom on-screen-auto-update t
 211   "Whether to update highlighting for successive scrolls.
 212 When non-nil, every scroll action will cause a highlighting
 213 according to the previously visible screenful.  When nil, a once
 214 drawn highlighting will remain fixed relative to the text even
 215 if you scroll further until `on-screen-delay' is over."
 216   :type 'boolean)
 217
 218 (defcustom on-screen-remove-when-edit nil
 219   "Whether to instantly remove highlighting when editing.
 220
 221 In those situations where a single command causes multiple
 222 changes to a buffer highlighting is always removed to avoid
 223 confusion."
 224   :type 'boolean)
 225
 226 (defvar on-screen-treat-cut-lines--default-fraction .3)
 227
 228 (defcustom on-screen-treat-cut-lines nil
 229   "Whether to care about vertically cut lines.
 230 If nil, always count lines at the window start or end that are
 231 only partially visible as part of the visible area.  Else, a
 232 number between 0 and 1, meaning that lines will count as visible
 233 when the hidden part of them is less than this number.  Note that
 234 a non-nil value may make scrolling stuttering on slow computers."
 235   :type `(choice (const :tag "Count partially visible lines as visible"   nil)
 236                  (const :tag "Count partially visible lines as not visible" t)
 237                  (float
 238                   :tag "Count lines with hidden part less than this as visible"
 239                   :value ,on-screen-treat-cut-lines--default-fraction)))
 240
 241 (defcustom on-screen-drawing-threshold 2
 242   "If set, highlight only when scrolled at least that many lines."
 243   :type '(choice (const :tag "Off" nil)
 244                  (integer :value 2)))
 245
 246 (defvar on-screen-inhibit-highlighting nil
 247   "Disable highlighting if non-nil.
 248 This variable is checked before highlighting is actually being
 249 performed, with the according buffer being current.
 250
 251 If a function, it will be called with zero arguments.
 252 Highlighting will be inhibited if the result is non-nil.")
 253
 254
 255 ;;;; Other variables
 256
 257 (defvar on-screen-overlay-priority 30     ; > stripe buffer, < ediff, isearch
 258   "Priority for all on-screen overlays.")
 259
 260 (defvar on-screen-initialized-p nil
 261   "Whether we have already added stuff to the hooks.")
 262
 263 (defvar on-screen-data nil
 264   "Association list holding internal data.")
 265
 266 (defvar on-screen-command-counter 0)
 267 (defvar on-screen-last-change 0)
 268
 269
 270 ;;;; User Commands
 271
 272 ;;;###autoload
 273 (define-minor-mode on-screen-mode
 274   "Buffer local minor mode guiding your eyes while scrolling.
 275 With a prefix argument ARG, enable the mode if ARG is positive,
 276 and disable it otherwise.  If called from Lisp, enable the mode
 277 if ARG is omitted or nil.
 278 Type M-x customize-group on-screen RET for configuration."
 279   :group 'on-screen
 280   (when on-screen-mode
 281     (unless on-screen-initialized-p
 282       (on-screen-initialize))))
 283
 284 ;;;###autoload
 285 (define-minor-mode on-screen-global-mode
 286   "Global minor mode guiding your eyes while scrolling.
 287 With a prefix argument ARG, enable the mode if ARG is positive,
 288 and disable it otherwise.  If called from Lisp, enable the mode
 289 if ARG is omitted or nil.
 290
 291 You can make use of `on-screen-inhibit-highlighting' to prevent
 292 highlighting on a per-buffer basis.
 293
 294 Type M-x customize-group on-screen RET for configuration."
 295   :group 'on-screen :global t
 296   (when on-screen-global-mode
 297     (unless on-screen-initialized-p
 298       (on-screen-initialize))))
 299
 300 ;;;###autoload
 301 (defalias 'global-on-screen-mode 'on-screen-global-mode)
 302
 303
 304 ;;;; Internal functions
 305
 306 (defun on-screen--treat-cut-lines-get-fraction ()
 307   (if (floatp on-screen-treat-cut-lines)
 308       on-screen-treat-cut-lines
 309     on-screen-treat-cut-lines--default-fraction))
 310
 311 (defun on-screen-window-start (&optional window)
 312   "Like `window-start', but exclude partially visible lines."
 313   (let* ((start (window-start window))
 314          (vis (and on-screen-treat-cut-lines (pos-visible-in-window-p start window t))))
 315     (if (not (cddr vis))
 316         start
 317       (cl-destructuring-bind (_x _y rtop _rbot rowh _vpos) vis
 318         (if (< (/ (float rtop) (+ rtop rowh))
 319                (on-screen--treat-cut-lines-get-fraction)) ; count as visible
 320             start
 321           (with-current-buffer (window-buffer window)
 322             (save-excursion
 323               (goto-char start)
 324               (on-screen-beginning-of-line +2)
 325               (point))))))))
 326
 327 (defun on-screen-window-end (&optional window)
 328   "Like `window-end', but exclude partially visible lines."
 329   (let* ((end (window-end window))
 330          (vis (and on-screen-treat-cut-lines (pos-visible-in-window-p (1- end) window t))))
 331     (if (not (cddr vis))
 332         end
 333       (cl-destructuring-bind (_x _y _rtop rbot rowh _vpos) vis
 334         (if (< (/ (float rbot) (+ rbot rowh))
 335                (on-screen--treat-cut-lines-get-fraction)) ; count as visible
 336             end
 337           (with-current-buffer (window-buffer window)
 338             (save-excursion
 339               (goto-char end)
 340               (on-screen-beginning-of-line 0)
 341               (point))))))))
 342
 343 (defun on-screen-beginning-of-line (&optional n)
 344   (cl-callf or n 1)
 345   (forward-visible-line (- n 1)))
 346
 347 (defun on-screen-end-of-line (&optional n)
 348   (cl-callf or n 1)
 349   (forward-visible-line (- n 1))
 350   (end-of-visible-line))
 351
 352 (defun on-screen-record-data (win area &optional timer overlays)
 353   ;; The collected data has the form ((beg end) timer overlays), and
 354   ;; this is what `on-screen-get-data' returns.  Internally, this
 355   ;; function also remembers the window-buffer of the window, to
 356   ;; enable the mode to check if remembered data still belongs to the
 357   ;; same buffer.
 358   "Store information for window WIN in `on-screen-data'.
 359 AREA is a list (beg end).  TIMER is the currently active timer
 360 object.  OVERLAYS are the on-screen overlays currently visible in
 361 WIN.
 362
 363 A nil value for AREA, TIMER or OVERLAYS means that the remembered
 364 values should not be changed.  If TIMER is the symbol `finished',
 365 remember nil for the timer."
 366   (let* ((entry (assoc win on-screen-data))
 367          (data  (cdr entry))
 368          (same-buffer-p (eq (car data) (window-buffer win))))
 369     (setq area  (or area        (and same-buffer-p (cadr data)))
 370           timer (cond  ((timerp timer) timer)
 371                        (timer nil)
 372                        (t (and same-buffer-p (cl-caddr data))))
 373           overlays (or overlays (and same-buffer-p (cl-cadddr data)))
 374           data  `(,(window-buffer win) ,area ,timer ,overlays))
 375     (if entry
 376         (setcdr entry data)
 377       (push (cons win data) on-screen-data))))
 378
 379 (defun on-screen-get-data (win)
 380   "Return stored data for WIN if existent and up-to-date."
 381   (let ((data (cdr (assoc win on-screen-data))))
 382     (if (eq (car data) (window-buffer win))
 383         (cdr data)
 384       nil)))
 385
 386 (defun on-screen-cleanup-data ()
 387   "Delete information stored for deleted windows."
 388   (setq on-screen-data
 389         (delq nil (mapcar (lambda (entry) (if (window-live-p (car entry)) entry nil))
 390                           on-screen-data))))
 391
 392 (defun on-screen-derive-from-frame-bg
 393   (win delta-brightness-dark-bg delta-brightness-light-bg delta-hue)
 394   "Helper calculating a suitable background color for highlighting."
 395   (let ((frame (window-frame win)))
 396     (and (display-graphic-p frame) (featurep 'hexrgb)
 397          (let* ((bg (or (let ((frame-bg  (cdr (assq 'background-color (frame-parameters frame)))))
 398                           (when (member frame-bg '(nil unspecified "unspecified-bg"))
 399                             (setq frame-bg  (if (eq (frame-parameter frame 'background-mode) 'dark)
 400                                                 "Black"
 401                                               "White")))
 402                           (and frame-bg  (x-color-defined-p frame-bg)  frame-bg))))
 403                 (sat (condition-case nil (hexrgb-saturation bg) (error nil))))
 404            (and sat
 405                 (if (hexrgb-approx-equal sat 0.0)
 406                     ;; Grayscale - change bg value slightly.
 407                     (hexrgb-increment-value
 408                      bg (if (eq (frame-parameter frame 'background-mode) 'dark)
 409                             delta-brightness-dark-bg
 410                           delta-brightness-light-bg))
 411                   (hexrgb-increment-hue bg delta-hue)) ; Color - change bg hue slightly.
 412                 )))))
 413
 414 (defun on-screen-get-shadow-face (win)
 415   "Return face for the transparent overlay in WIN."
 416   (if (eq on-screen-highlight-method 'shadow)
 417       (or (and on-screen-highlighting-to-background-delta
 418                (let ((bg-col (apply #'on-screen-derive-from-frame-bg win
 419                                     (mapcar (lambda (x) (* x on-screen-highlighting-to-background-delta))
 420                                             (list 1 -1 1)))))
 421                  (and bg-col `((t (:background ,bg-col))))))
 422           'on-screen-shadow)
 423     'on-screen-hl-line))
 424
 425 (defun on-screen-make-fringe-overlays (pos topp &optional inversep)
 426   "Create and return list of fringe overlays."
 427   (let (ov1 ov2)
 428     (unless (eq on-screen-fringe-marker-position 'left)
 429       (setq ov1  (save-excursion (make-overlay (progn (goto-char pos)
 430                                                       (on-screen-beginning-of-line
 431                                                        (cond ((not inversep) +1)
 432                                                              (topp           +2)
 433                                                              (t               0)))
 434                                                       (point))
 435                                                (1+ (point)))))
 436       (overlay-put ov1 'before-string (on-screen-fringe-string topp nil inversep)))
 437     (unless (eq on-screen-fringe-marker-position 'right)
 438       (setq ov2  (save-excursion (make-overlay (progn (goto-char pos)
 439                                                       (on-screen-beginning-of-line
 440                                                        (cond ((not inversep) +1)
 441                                                              (topp           +2)
 442                                                              (t               0)))
 443                                                       (point))
 444                                                (1+ (point)))))
 445       (overlay-put ov2 'before-string (on-screen-fringe-string topp t inversep)))
 446     (delq nil (list ov1 ov2))))
 447
 448 (defun on-screen-fringe-string (topp leftp &optional inversep)
 449   "Return a string suitable for displaying fringe markers."
 450   (let ((xor (lambda (x y) (if x (not y) y))))
 451     (propertize (purecopy " ")
 452                 'display  (list (if leftp 'left-fringe 'right-fringe)
 453                                 (if (funcall xor topp (not inversep))
 454                                     (if leftp 'top-left-angle 'top-right-angle)
 455                                   (if leftp 'bottom-left-angle 'bottom-right-angle))
 456                                 'on-screen-fringe))))
 457
 458 (defun on-screen-make-line-overlay (pos)
 459   "Create an overlay around POS for the line method."
 460   (save-excursion
 461     (make-overlay (progn (goto-char pos) (on-screen-beginning-of-line)     (point))
 462                   (progn (goto-char pos) (on-screen-end-of-line)       (1+ (point))))))
 463
 464 (defun on-screen-make-narrow-line-overlay (win pos)
 465   "Create an overlay around POS for the narrow-line method."
 466   (let ((ov (save-excursion
 467               (make-overlay (progn (goto-char pos) (on-screen-beginning-of-line) (point))
 468                             (progn (goto-char pos) (on-screen-end-of-line)       (point))))))
 469     (overlay-put ov 'face 'on-screen-narrow-line)
 470     ;; The following is necessary to get a line spanning the entire
 471     ;; window width, because underlining is only applied to text - a
 472     ;; problem especially for empty lines.  However this hides any
 473     ;; other highlighting there, e.g. from stripe-buffer or
 474     ;; hl-line-mode.  I think there's nothing I can do about that.
 475     (overlay-put ov 'after-string (propertize "foo"
 476                                               'face 'on-screen-narrow-line
 477                                               'display `(space :align-to ,(window-width win))
 478                                               'cursor 0))
 479     ov))
 480
 481 (defun on-screen-get-windows (&optional all-frames)
 482   "Return a list of all windows.
 483 With ALL-FRAMES non-nil, include all windows of all frames, else
 484 only the windows of the selected frame."
 485   (apply #'nconc
 486          (mapcar (lambda (frame) (window-list frame))
 487                  (if all-frames (frame-list) (list (selected-frame))))))
 488
 489 (defun on-screen-pre-command ()
 490   "Remember visible buffer parts in the selected frame."
 491   ;;   This normally goes to `pre-command-hook'.
 492   (cl-incf on-screen-command-counter)
 493   (add-hook 'after-change-functions #'on-screen-after-change) ;$$$$ bug#16796
 494   (condition-case nil
 495       (mapc (lambda (win) (with-current-buffer (window-buffer win)
 496                        (when (on-screen-enabled-p)
 497                          (on-screen-record-data win (list (on-screen-window-start win)
 498                                                           (on-screen-window-end   win))))))
 499             (on-screen-get-windows))
 500     ((debug error) nil)))
 501
 502 (defun on-screen-after-scroll (win display-start)
 503   "DTRT after scrolling.
 504 This should normally go to `window-scroll-functions'."
 505   (condition-case nil
 506       (with-current-buffer (window-buffer win)
 507         (when (on-screen-enabled-p)
 508           (let* ((win-data (on-screen-get-data win))
 509                  (area     (car  win-data))
 510                  (timer    (cadr win-data))
 511                  (overlays (cl-caddr win-data))
 512                  (s1       (car area))
 513                  (s2       (cadr area)))
 514             (when (and
 515                    on-screen-auto-update
 516                    (timerp timer)
 517                    ;; avoid removing highlighting when `window-scroll-functions' is
 518                    ;; called multiple times in succession (follow-mode does that)
 519                    (not (eq (car-safe area) (on-screen-window-start win))))
 520               ;; do what the timer would do, and cancel timer
 521               (on-screen-remove-highlighting win)
 522               (cancel-timer timer)
 523               (on-screen-record-data win area 'finished)
 524               (setq timer nil))
 525             (cond
 526              ((timerp timer)
 527               (timer-set-time timer (timer-relative-time (current-time) on-screen-delay)))
 528              ((or (not area)
 529                   (= display-start s1)))
 530              ((and (numberp on-screen-drawing-threshold)
 531                    (< (abs (apply #'count-lines (sort (list display-start s1) #'<)))
 532                       on-screen-drawing-threshold)))
 533              (t
 534               (setq
 535                overlays
 536                (let ((method `(,on-screen-highlight-method . ,on-screen-inverse-flag)))
 537
 538                  ;; prevent highlighting in certain situations
 539                  ;; note that `window-end' must not be used here!
 540
 541                  (when (and s1 s2
 542                             (pos-visible-in-window-p (point-min) win)
 543                             (pos-visible-in-window-p (point-max) win))
 544                    ;; after narrow
 545                    (setq s1 nil s2 nil))
 546
 547                  (when (and s1 s2
 548                             (>= s2 (point-max))
 549                             (< s1 (on-screen-window-start win))
 550                             (pos-visible-in-window-p (point-max) win))
 551                    ;;scrolling down near buffer end
 552                    (setq s2 nil))
 553
 554                  (cond
 555                   ((equal method '(shadow . nil))
 556                    (if (and s1 s2) (list (make-overlay s1 s2)) ()))
 557                   ((eq (car method) 'shadow)
 558                    (list (and s1 (make-overlay (point-min)  s1))
 559                          (and s2 (make-overlay          s2  (point-max)))))
 560                   ((eq (car method) 'fringe)
 561                    (append (and s1 (on-screen-make-fringe-overlays     s1  nil (cdr method)))
 562                            (and s2 (on-screen-make-fringe-overlays (1- s2)   t (cdr method)))))
 563                   ((equal method '(line . nil))
 564                    (list (and s1 (on-screen-make-line-overlay     s1))
 565                          (and s2 (on-screen-make-line-overlay (1- s2)))))
 566                   ((eq (car method) 'line)
 567                    (list (and s1 (on-screen-make-line-overlay (1- s1)))
 568                          (and s2 (on-screen-make-line-overlay     s2))))
 569                   ((eq (car method) 'narrow-line)
 570                    (list (and s1 (on-screen-make-narrow-line-overlay win (1- s1)))
 571                          (and s2 (on-screen-make-narrow-line-overlay win (1- s2)))))))
 572                overlays (delq nil overlays))
 573               (dolist (ov overlays)
 574                 (overlay-put ov 'window win) ; display only in selected window
 575                 (overlay-put ov 'priority on-screen-overlay-priority))
 576               (when (memq on-screen-highlight-method '(shadow line))
 577                 (dolist (ov overlays)
 578                   (overlay-put ov 'face (on-screen-get-shadow-face win))))
 579               (on-screen-record-data
 580                win nil
 581                (run-at-time (time-add (current-time) (seconds-to-time on-screen-delay)) nil
 582                             (lambda (win)
 583                               (condition-case nil
 584                                   (progn
 585                                     (when (window-live-p win)
 586                                       (with-current-buffer (window-buffer win)
 587                                         (on-screen-remove-highlighting win)
 588                                         (on-screen-record-data
 589                                          win (list (on-screen-window-start win)
 590                                                    (on-screen-window-end win))
 591                                          'finished)))
 592                                     (on-screen-cleanup-data))
 593                                 ((debug error) nil)))
 594                             win)
 595                overlays))))))
 596     ((debug error) nil)))
 597
 598 (defun on-screen-remove-highlighting (win)
 599   "Delete all on-screen overlays in window WIN.
 600 This has to be done for a previously buffer if the window-buffer
 601 had changed."
 602   (let* ((entry (assoc win on-screen-data))
 603          (data  (cdr entry))
 604          (buffer (car data)))
 605     (when (buffer-live-p buffer)
 606       (with-current-buffer buffer
 607         (let* ((data     (cdr data))
 608                (timer    (cadr data))
 609                (overlays (cl-caddr data)))
 610           (dolist (ov overlays) (delete-overlay ov))
 611           (when (timerp timer) (cancel-timer timer))))
 612       (setq on-screen-data (delq entry on-screen-data)))))
 613
 614 (defun on-screen-after-change (&rest _)
 615   "Reset highligting for current buffer after it was changed.
 616 This has to be done for all its windows.  Goes to
 617 `after-change-functions'."
 618   (when (or on-screen-remove-when-edit
 619             (= on-screen-last-change on-screen-command-counter))
 620     (let ((buf (current-buffer)))
 621       (when (on-screen-enabled-p buf)
 622         (dolist (win (on-screen-get-windows t))
 623           (when (eq (window-buffer win) buf)
 624             (on-screen-remove-highlighting win))))))
 625   (setq on-screen-last-change on-screen-command-counter))
 626
 627 (defun on-screen-after-wconf-change ()
 628   "Clean up after the window configuration has changed.
 629 I.e., for all windows of the selected frame, remove all
 630 highlightings and clear all associated data."
 631   (let ((wins (on-screen-get-windows)))
 632     (dolist (win wins)
 633       (on-screen-remove-highlighting win))))
 634
 635 (defun on-screen-enabled-p (&optional buffer)
 636   "Return non-nil if on-screen is enabled in BUFFER."
 637   (with-current-buffer (or buffer (current-buffer))
 638     (and
 639      (or on-screen-global-mode on-screen-mode)
 640      (cond
 641       ((not on-screen-inhibit-highlighting) t)
 642       ((functionp on-screen-inhibit-highlighting)
 643        (not (funcall on-screen-inhibit-highlighting)))
 644       (t nil)))))
 645
 646 (defun on-screen-initialize ()
 647   "Prepare for using on-screen."
 648   (add-hook 'pre-command-hook        #'on-screen-pre-command)
 649   (add-hook 'window-scroll-functions #'on-screen-after-scroll)
 650   (add-hook 'after-change-functions  #'on-screen-after-change)
 651   (add-hook 'window-configuration-change-hook #'on-screen-after-wconf-change)
 652   (setq on-screen-initialized-p t))
 653
 654 (defun on-screen-unload-function ()
 655   "Function to run when unloading on-screen."
 656   (remove-hook 'pre-command-hook        #'on-screen-pre-command)
 657   (remove-hook 'window-scroll-functions #'on-screen-after-scroll)
 658   (remove-hook 'after-change-functions  #'on-screen-after-change)
 659   (remove-hook 'window-configuration-change-hook #'on-screen-after-wconf-change)
 660   nil)
 661
 662
 663 (provide 'on-screen)
 664
 665 ;;; on-screen.el ends here