;;; on-screen.el --- guide your eyes while scrolling -*- lexical-binding: t -*-
-;; Copyright (C) 2013 - 2015 Michael Heerdegen
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc
;; Author: Michael Heerdegen <michael_heerdegen@web.de>
;; Maintainer: Michael Heerdegen <michael_heerdegen@web.de>
;; Created: 24 Jan 2013
;; Keywords: convenience
-;; Homepage: https://github.com/michael-heerdegen/on-screen.el
-;; Version: 1.1
+;; URL: https://github.com/michael-heerdegen/on-screen.el
+;; Version: 1.3.2
;; Package-Requires: ((cl-lib "0"))
;;; Code:
-;;; Requirements
+;;;; Requirements
-(require 'cl-lib)
+(eval-when-compile
+ (require 'cl-lib))
(require 'timer)
(require 'hexrgb nil t)
+(declare-function hexrgb-saturation "hexrgb")
+(declare-function hexrgb-approx-equal "hexrgb")
+(declare-function hexrgb-increment-value "hexrgb")
+(declare-function hexrgb-increment-hue "hexrgb")
-;;; Configuration stuff
+
+;;;; Configuration stuff
(defgroup on-screen nil
"Guide your eyes while scrolling."
"What area to highlight.
When nil, highlight the previously visible screenful. Else
highlight the previously off-screen parts."
- :group 'on-screen :type 'boolean)
+ :type 'boolean)
(defcustom on-screen-highlight-method 'fringe
"Type of highlighting used by `on-screen-mode'.
(const :tag "Fringe markers" fringe)
(const :tag "Transparent overlay" shadow)
(const :tag "Overlay on confining text lines" line)
- (const :tag "Narrow horizontal line" narrow-line))
- :group 'on-screen)
+ (const :tag "Narrow horizontal line" narrow-line)))
(defcustom on-screen-fringe-marker-position t
"Where to display fringe markers.
:type '(choice
(const :tag "Left fringe only" left)
(const :tag "Right fringe only" right)
- (const :tag "Both sides" t))
- :group 'on-screen)
+ (const :tag "Both sides" t)))
(defface on-screen-shadow
'((((class color) (min-colors 88) (background light))
- :background "#f2efcb" ;; alternative: "#f5f4ff" is a bit less intrusive
+ :background "#f2efcb" ; alternative: "#f5f4ff" is a bit less intrusive
)
(((class color) (min-colors 88) (background dark))
:background "#272620")
:background "green")
(((class color) (min-colors 8) (background dark))
:background "blue"))
- "Face used for displaying a transparent overlay."
- :group 'on-screen)
+ "Face used for displaying a transparent overlay.")
+
+(defface on-screen-hl-line
+ '((((background light)) :background "#ffa0a0")
+ (((background dark)) :background "#300000"))
+ "Face used for displaying the \"line\" style overlay.")
(defcustom on-screen-highlighting-to-background-delta .05
"How much shadow and line highlighting should differ from background.
This variable is ignored if the library \"hexrgb\" is not
available."
- :group 'on-screen
:type '(choice (const :tag "Use standard face" nil)
(float :tag "Delta")))
(defface on-screen-fringe '((t (:inherit shadow)))
- "Face used for fringe markers."
- :group 'on-screen)
+ "Face used for fringe markers.")
(defface on-screen-narrow-line
'((((background dark)) (:width extra-expanded :underline (:color "gray30" :style wave)))
(((background light)) (:width extra-expanded :underline (:color "gray70" :style wave))))
- "Face used by the narrow-line highlighting method."
- :group 'on-screen)
+ "Face used by the narrow-line highlighting method.")
(defcustom on-screen-delay 5
"How long `on-screen-mode' should display optical aids."
- :group 'on-screen :type 'number)
+ :type 'number)
(defcustom on-screen-auto-update t
"Whether to update highlighting for successive scrolls.
according to the previously visible screenful. When nil, a once
drawn highlighting will remain fixed relative to the text even
if you scroll further until `on-screen-delay' is over."
- :group 'on-screen :type 'boolean)
+ :type 'boolean)
(defcustom on-screen-remove-when-edit nil
"Whether to instantly remove highlighting when editing.
In those situations where a single command causes multiple
changes to a buffer highlighting is always removed to avoid
confusion."
- :group 'on-screen :type 'boolean)
+ :type 'boolean)
+
+(defvar on-screen-treat-cut-lines--default-fraction .3)
-(defcustom on-screen-treat-cut-lines t
+(defcustom on-screen-treat-cut-lines nil
"Whether to care about vertically cut lines.
If nil, always count lines at the window start or end that are
only partially visible as part of the visible area. Else, a
number between 0 and 1, meaning that lines will count as visible
when the hidden part of them is less than this number. Note that
a non-nil value may make scrolling stuttering on slow computers."
- :group 'on-screen
- :type '(choice (const :tag "Count vertically cut lines as visible" nil)
- (float :tag "Count lines with hidden part less than this as visible"
- :value .4)))
+ :type `(choice (const :tag "Count partially visible lines as visible" nil)
+ (const :tag "Count partially visible lines as not visible" t)
+ (float
+ :tag "Count lines with hidden part less than this as visible"
+ :value ,on-screen-treat-cut-lines--default-fraction)))
(defcustom on-screen-drawing-threshold 2
"If set, highlight only when scrolled at least that many lines."
- :group 'on-screen
:type '(choice (const :tag "Off" nil)
(integer :value 2)))
-;;; Other variables
+(defvar on-screen-inhibit-highlighting nil
+ "Disable highlighting if non-nil.
+This variable is checked before highlighting is actually being
+performed, with the according buffer being current.
+
+If a function, it will be called with zero arguments.
+Highlighting will be inhibited if the result is non-nil.")
+
+
+;;;; Other variables
(defvar on-screen-overlay-priority 30 ; > stripe buffer, < ediff, isearch
"Priority for all on-screen overlays.")
(defvar on-screen-last-change 0)
-;;; User Commands
+;;;; User Commands
;;;###autoload
(define-minor-mode on-screen-mode
With a prefix argument ARG, enable the mode if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil.
+
+You can make use of `on-screen-inhibit-highlighting' to prevent
+highlighting on a per-buffer basis.
+
Type M-x customize-group on-screen RET for configuration."
:group 'on-screen :global t
(when on-screen-global-mode
(defalias 'global-on-screen-mode 'on-screen-global-mode)
-;;; Internal functions
+;;;; Internal functions
+
+(defun on-screen--treat-cut-lines-get-fraction ()
+ (if (floatp on-screen-treat-cut-lines)
+ on-screen-treat-cut-lines
+ on-screen-treat-cut-lines--default-fraction))
(defun on-screen-window-start (&optional window)
"Like `window-start', but exclude partially visible lines."
start
(cl-destructuring-bind (_x _y rtop _rbot rowh _vpos) vis
(if (< (/ (float rtop) (+ rtop rowh))
- (if (floatp on-screen-treat-cut-lines) on-screen-treat-cut-lines .4)) ;; count as visible
+ (on-screen--treat-cut-lines-get-fraction)) ; count as visible
start
(with-current-buffer (window-buffer window)
(save-excursion
end
(cl-destructuring-bind (_x _y _rtop rbot rowh _vpos) vis
(if (< (/ (float rbot) (+ rbot rowh))
- (if (floatp on-screen-treat-cut-lines) on-screen-treat-cut-lines .4)) ;; count as visible
+ (on-screen--treat-cut-lines-get-fraction)) ; count as visible
end
(with-current-buffer (window-buffer window)
(save-excursion
(defun on-screen-get-shadow-face (win)
"Return face for the transparent overlay in WIN."
- (or (and on-screen-highlighting-to-background-delta
- (let ((bg-col (apply #'on-screen-derive-from-frame-bg win
- (mapcar (lambda (x) (* x on-screen-highlighting-to-background-delta))
- (list 1 -1 1)))))
- (and bg-col `((t (:background ,bg-col))))))
- 'on-screen-shadow))
+ (if (eq on-screen-highlight-method 'shadow)
+ (or (and on-screen-highlighting-to-background-delta
+ (let ((bg-col (apply #'on-screen-derive-from-frame-bg win
+ (mapcar (lambda (x) (* x on-screen-highlighting-to-background-delta))
+ (list 1 -1 1)))))
+ (and bg-col `((t (:background ,bg-col))))))
+ 'on-screen-shadow)
+ 'on-screen-hl-line))
(defun on-screen-make-fringe-overlays (pos topp &optional inversep)
"Create and return list of fringe overlays."
(pos-visible-in-window-p (point-max) win))
;; after narrow
(setq s1 nil s2 nil))
-
+
(when (and s1 s2
(>= s2 (point-max))
(< s1 (on-screen-window-start win))
overlays (delq nil overlays))
(dolist (ov overlays)
(overlay-put ov 'window win) ; display only in selected window
- (overlay-put ov 'priority on-screen-overlay-priority))
+ (overlay-put ov 'priority on-screen-overlay-priority))
(when (memq on-screen-highlight-method '(shadow line))
(dolist (ov overlays)
(overlay-put ov 'face (on-screen-get-shadow-face win))))
(defun on-screen-enabled-p (&optional buffer)
"Return non-nil if on-screen is enabled in BUFFER."
(with-current-buffer (or buffer (current-buffer))
- (if on-screen-global-mode t on-screen-mode)))
+ (and
+ (or on-screen-global-mode on-screen-mode)
+ (cond
+ ((not on-screen-inhibit-highlighting) t)
+ ((functionp on-screen-inhibit-highlighting)
+ (not (funcall on-screen-inhibit-highlighting)))
+ (t nil)))))
(defun on-screen-initialize ()
"Prepare for using on-screen."
(add-hook 'window-configuration-change-hook #'on-screen-after-wconf-change)
(setq on-screen-initialized-p t))
+(defun on-screen-unload-function ()
+ "Function to run when unloading on-screen."
+ (remove-hook 'pre-command-hook #'on-screen-pre-command)
+ (remove-hook 'window-scroll-functions #'on-screen-after-scroll)
+ (remove-hook 'after-change-functions #'on-screen-after-change)
+ (remove-hook 'window-configuration-change-hook #'on-screen-after-wconf-change)
+ nil)
+
(provide 'on-screen)