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

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