larstvei/Focus
1
0
Fork 0
mirror of https://github.com/larstvei/Focus.git synced 2024-11-26 11:38:32 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Rewrite color-preserving dimming without face-remap

Browse Source 
Rather than using face-remap for efficient dimming and restoring colors in the
focused area, just dim /visible/ text in the unfocused region. The main
argument for this approach is that there are many corner cases in restoring the
colors correctly, and inaccuracies in the coloring is less crucial in the
unfocused area.
This commit is contained in:
Lars Tveito 2020-03-08 18:32:39 +01:00
parent af05a01667
commit 28b7662f26
1 changed files with 91 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

191
focus.el
View File

@ -31,7 +31,6 @@
;;; Code: ;;; Code:
(require 'cl-lib) (require 'cl-lib)
(require 'face-remap)
(require 'org-element) (require 'org-element)
(require 'thingatpt) (require 'thingatpt)
@ -85,21 +84,21 @@ Things that are defined include `symbol', `list', `sexp',
(defvar-local focus-buffer nil (defvar-local focus-buffer nil
"Local reference to the buffer focus functions operate on.") "Local reference to the buffer focus functions operate on.")
(defvar-local focus-pre-overlay nil (defvar-local focus-unfocused-overlays nil
"The overlay that dims the text prior to the current-point.") "The overlays that dims the unfocused area.")
(defvar-local focus-post-overlay nil (defvar-local focus-focused-overlay nil
"The overlay that dims the text past the current-point.") "The overlay that is added to the focused area.")
(defvar-local focus-mid-overlays nil (defvar-local focus-pin-bounds nil
"These overlays restore original colors in the focused area.") "Bounds set by `focus-pin'.")
(defvar-local focus-remap-cookies nil
"A list of cookies used for deleting the face remapping.")
(defvar-local focus-last-bounds nil (defvar-local focus-last-bounds nil
"Used to identify changes in `focus-bounds'.") "Used to identify changes in `focus-bounds'.")
(defvar-local focus-last-window-bounds nil
"Used to identify changes in `window-start' and `window-end'.")
(defvar-local focus-last-background nil (defvar-local focus-last-background nil
"Used to identify changes in the background.") "Used to identify changes in the background.")
@ -108,38 +107,6 @@ Things that are defined include `symbol', `list', `sexp',
The timer calls `focus-read-only-hide-cursor' after The timer calls `focus-read-only-hide-cursor' after
`focus-read-only-blink-seconds' seconds.") `focus-read-only-blink-seconds' seconds.")
(defun focus-lerp (c1 c2 d)
"Interpolate C1 with C2, where D controls the amount."
(apply 'color-rgb-to-hex
(cl-mapcar (lambda (x y) (+ (* x (- 1 d)) (* y d))) c1 c2)))
(defun focus-remap-foreground-color-from-face (face)
"Remap the foreground color of FACE to a dimmed color."
(let ((fg (face-foreground face))
(bg (face-background 'default)))
(when (and fg bg (color-defined-p fg) (color-defined-p bg))
(let* ((new-fg (focus-lerp (color-name-to-rgb fg)
(color-name-to-rgb bg)
focus-fraction))
(cookie (face-remap-add-relative face `(:foreground ,new-fg))))
(push cookie focus-remap-cookies)))))
(defun focus-reset-remapping ()
"Clean up remappings stored in `focus-remap-cookies'."
(while focus-remap-cookies
(face-remap-remove-relative
(pop focus-remap-cookies))))
(defun focus-dim-buffer ()
"Dim the colors of relevant faces in the buffer."
(focus-reset-remapping)
;; Most faces that alters the background are better left undimmed. The
;; default face is, however, a clear exception.
(focus-remap-foreground-color-from-face 'default)
(dolist (face (face-list))
(when (and (not (face-background face))
(face-foreground face))
(focus-remap-foreground-color-from-face face))))
(defun focus-get-thing () (defun focus-get-thing ()
"Return the current thing, based on `focus-mode-to-thing'." "Return the current thing, based on `focus-mode-to-thing'."
@ -151,17 +118,33 @@ The timer calls `focus-read-only-hide-cursor' after
(defun focus-bounds () (defun focus-bounds ()
"Return the current bounds, based on `focus-get-thing'." "Return the current bounds, based on `focus-get-thing'."
(let ((thing (focus-get-thing))) (or focus-pin-bounds
(cond ((eq thing 'org-element) (let ((thing (focus-get-thing)))
(let* ((elem (org-element-at-point)) (cond ((eq thing 'org-element)
(beg (org-element-property :begin elem)) (let* ((elem (org-element-at-point))
(end (org-element-property :end elem))) (beg (org-element-property :begin elem))
(and beg end (cons beg end)))) (end (org-element-property :end elem)))
(t (bounds-of-thing-at-point thing))))) (and beg end (cons beg end))))
(t (bounds-of-thing-at-point thing))))))
(defun focus-make-focused-face (fg) (defun focus-window-bounds ()
"Add original foreground color FG to the `focus-focused` face." (cons (window-start) (window-end nil t)))
(plist-put (face-attr-construct 'focus-focused) :foreground fg))
(defun focus-lerp (c1 c2 d)
"Interpolate C1 with C2, where D controls the amount."
(apply 'color-rgb-to-hex
(cl-mapcar (lambda (x y) (+ (* x (- 1 d)) (* y d))) c1 c2)))
(defun focus-make-unfocused-face (fg)
"Add dimmed foreground color FG to the `focus-unfocused` face."
(let ((bg (face-background 'default)))
(when (and fg bg (color-defined-p fg) (color-defined-p bg))
(if (color-defined-p (face-attribute 'focus-unfocused :foreground))
'focus-unfocused
(plist-put (face-attr-construct 'focus-unfocused)
:foreground (focus-lerp (color-name-to-rgb fg)
(color-name-to-rgb bg)
focus-fraction))))))
(defun focus-foreground-from-face (face) (defun focus-foreground-from-face (face)
"Return foreground color for FACE, or 'default if nil." "Return foreground color for FACE, or 'default if nil."
@ -169,43 +152,56 @@ The timer calls `focus-read-only-hide-cursor' after
(face-attribute face :foreground) (face-attribute face :foreground)
(face-attribute 'default :foreground))) (face-attribute 'default :foreground)))
(defun focus-undim-area (low high) (defun focus-dim-area (low high)
"Restore original colors between LOW and HIGH. "Restore original colors between LOW and HIGH.
Returns the list of added overlays." Returns the list of added overlays."
(when (< low high) (while (< low high)
(let* ((next (min high (or (next-property-change low) high))) (let ((next (next-single-property-change low 'face nil high)))
(face (get-text-property low 'face)) (if (invisible-p low)
(fg (focus-foreground-from-face face)) (setq low (next-single-char-property-change low 'invisible nil high))
(restored-face (focus-make-focused-face fg)) (let* ((face (get-text-property low 'face))
(o (make-overlay low next))) (fg (focus-foreground-from-face face))
(overlay-put o 'face restored-face) (unfocused-face (focus-make-unfocused-face fg))
(cons o (focus-undim-area next high))))) (o (make-overlay low next)))
(overlay-put o 'face unfocused-face)
(push o focus-unfocused-overlays)
(setq low next))))))
(defun focus-move-focus () (defun focus-remove-unfocused-overlays ()
(while focus-unfocused-overlays
(delete-overlay (pop focus-unfocused-overlays))))
(defun focus-move-focus (&rest args)
"Move the focused section according to `focus-bounds'. "Move the focused section according to `focus-bounds'.
If `focus-mode' is enabled, this command fires after each If `focus-mode' is enabled, this function is added to
command." `post-command-hook' and `window-scroll-functions'. The function
can be called with an arbitrary number of ARGS to support being
called from `window-scroll-functions'."
(with-current-buffer focus-buffer (with-current-buffer focus-buffer
(let* ((bounds (focus-bounds)) (let* ((bg (face-background 'default))
(bg (face-background 'default))) (window-bounds (focus-window-bounds))
(when (not (equal focus-last-background bg)) (bounds (focus-bounds)))
(focus-dim-buffer))
(when (and bounds (or (not (equal bg focus-last-background)) (when (and bounds (or (not (equal bg focus-last-background))
(not (equal window-bounds focus-last-window-bounds))
(not (equal bounds focus-last-bounds)))) (not (equal bounds focus-last-bounds))))
(let ((low (car bounds)) (let ((start (car window-bounds))
(end (cdr window-bounds))
(low (car bounds))
(high (cdr bounds))) (high (cdr bounds)))
(focus-move-overlays low high) (focus-remove-unfocused-overlays)
(mapc 'delete-overlay focus-mid-overlays) (focus-dim-area start low)
(setq focus-mid-overlays (focus-undim-area low high)))) (focus-dim-area high end)
(setq focus-last-bounds bounds) (move-overlay focus-focused-overlay low high)))
(setq focus-last-background bg)))) (setq focus-last-background bg)
(setq focus-last-window-bounds window-bounds)
(setq focus-last-bounds bounds))))
(defun focus-move-overlays (low high) (defun focus-make-focused-overlay ()
"Move `focus-pre-overlay' and `focus-post-overlay'." (let ((o (make-overlay (point-min) (point-max))))
(move-overlay focus-pre-overlay (point-min) low) (overlay-put o 'face 'focus-focused)
(move-overlay focus-post-overlay high (point-max))) o))
(defun focus-init () (defun focus-init ()
"This function run when command `focus-mode' is enabled. "This function run when command `focus-mode' is enabled.
@ -214,29 +210,25 @@ It sets the `focus-pre-overlay', `focus-min-overlay', and
`focus-post-overlay' to overlays; these are invisible until `focus-post-overlay' to overlays; these are invisible until
`focus-move-focus' runs. It adds `focus-move-focus' to `focus-move-focus' runs. It adds `focus-move-focus' to
`post-command-hook'." `post-command-hook'."
(unless (or focus-pre-overlay focus-post-overlay) (focus-cleanup)
(setq focus-pre-overlay (make-overlay (point-min) (point-min)) (setq focus-buffer (current-buffer))
focus-post-overlay (make-overlay (point-max) (point-max)) (setq focus-focused-overlay (focus-make-focused-overlay))
focus-buffer (current-buffer)) (add-hook 'post-command-hook 'focus-move-focus t t)
(overlay-put focus-pre-overlay 'face 'focus-unfocused) (add-hook 'window-scroll-functions 'focus-move-focus t t)
(overlay-put focus-post-overlay 'face 'focus-unfocused) (add-hook 'change-major-mode-hook 'focus-cleanup t t)
(add-hook 'post-command-hook 'focus-move-focus t t) (focus-move-focus))
(add-hook 'change-major-mode-hook 'focus-terminate t t)
(focus-move-focus)))
(defun focus-terminate () (defun focus-cleanup ()
"This function is run when command `focus-mode' is disabled. "This function is run when command `focus-mode' is disabled.
Overlays are deleted. `focus-move-focus' is removed from Overlays are deleted. `focus-move-focus' is removed from
`post-command-hook'." `post-command-hook'."
(let ((overlays (append (list focus-pre-overlay (let ((overlays (cons focus-focused-overlay focus-unfocused-overlays)))
focus-post-overlay)
focus-mid-overlays)))
(mapc (lambda (o) (and (overlayp o) (delete-overlay o))) overlays) (mapc (lambda (o) (and (overlayp o) (delete-overlay o))) overlays)
(remove-hook 'post-command-hook 'focus-move-focus t) (remove-hook 'post-command-hook 'focus-move-focus t)
(focus-reset-remapping) (remove-hook 'window-scroll-functions 'focus-move-focus t)
(setq focus-pre-overlay nil (setq focus-unfocused-overlays nil
focus-post-overlay nil focus-focused-overlay nil
focus-last-bounds nil focus-last-bounds nil
focus-last-background nil))) focus-last-background nil)))
@ -261,16 +253,15 @@ default is overwritten. This function simply helps set the
(defun focus-pin () (defun focus-pin ()
"Pin the focused section to its current location or the region, if active." "Pin the focused section to its current location or the region, if active."
(interactive) (interactive)
(when (bound-and-true-p focus-mode) (when (and (bound-and-true-p focus-mode)
(when (region-active-p) (region-active-p))
(focus-move-overlays (region-beginning) (region-end))) (setq focus-pin-bounds (cons (region-beginning) (region-end)))))
(remove-hook 'post-command-hook 'focus-move-focus t)))
(defun focus-unpin () (defun focus-unpin ()
"Unpin the focused section." "Unpin the focused section."
(interactive) (interactive)
(when (bound-and-true-p focus-mode) (when (bound-and-true-p focus-mode)
(add-hook 'post-command-hook 'focus-move-focus nil t))) (setq focus-pin-bounds nil)))
(defun focus-next-thing (&optional n) (defun focus-next-thing (&optional n)
"Move the point to the middle of the Nth next thing." "Move the point to the middle of the Nth next thing."
@ -345,7 +336,7 @@ It cleans up the `focus-read-only-blink-timer' and hooks."
:keymap (let ((map (make-sparse-keymap))) :keymap (let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-q") 'focus-read-only-mode) (define-key map (kbd "C-c C-q") 'focus-read-only-mode)
map) map)
(if focus-mode (focus-init) (focus-terminate))) (if focus-mode (focus-init) (focus-cleanup)))
;;;###autoload ;;;###autoload
(define-minor-mode focus-read-only-mode (define-minor-mode focus-read-only-mode