From 28b7662f2672b3aeccf9e6a43be1e98dc6db0e9f Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Sun, 8 Mar 2020 18:32:39 +0100 Subject: [PATCH] Rewrite color-preserving dimming without face-remap 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. --- focus.el | 191 ++++++++++++++++++++++++++----------------------------- 1 file changed, 91 insertions(+), 100 deletions(-) diff --git a/focus.el b/focus.el index 69819ac..44cad80 100644 --- a/focus.el +++ b/focus.el @@ -31,7 +31,6 @@ ;;; Code: (require 'cl-lib) -(require 'face-remap) (require 'org-element) (require 'thingatpt) @@ -85,21 +84,21 @@ Things that are defined include `symbol', `list', `sexp', (defvar-local focus-buffer nil "Local reference to the buffer focus functions operate on.") -(defvar-local focus-pre-overlay nil - "The overlay that dims the text prior to the current-point.") +(defvar-local focus-unfocused-overlays nil + "The overlays that dims the unfocused area.") -(defvar-local focus-post-overlay nil - "The overlay that dims the text past the current-point.") +(defvar-local focus-focused-overlay nil + "The overlay that is added to the focused area.") -(defvar-local focus-mid-overlays nil - "These overlays restore original colors in the focused area.") - -(defvar-local focus-remap-cookies nil - "A list of cookies used for deleting the face remapping.") +(defvar-local focus-pin-bounds nil + "Bounds set by `focus-pin'.") (defvar-local focus-last-bounds nil "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 "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 `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 () "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 () "Return the current bounds, based on `focus-get-thing'." - (let ((thing (focus-get-thing))) - (cond ((eq thing 'org-element) - (let* ((elem (org-element-at-point)) - (beg (org-element-property :begin elem)) - (end (org-element-property :end elem))) - (and beg end (cons beg end)))) - (t (bounds-of-thing-at-point thing))))) + (or focus-pin-bounds + (let ((thing (focus-get-thing))) + (cond ((eq thing 'org-element) + (let* ((elem (org-element-at-point)) + (beg (org-element-property :begin elem)) + (end (org-element-property :end elem))) + (and beg end (cons beg end)))) + (t (bounds-of-thing-at-point thing)))))) -(defun focus-make-focused-face (fg) - "Add original foreground color FG to the `focus-focused` face." - (plist-put (face-attr-construct 'focus-focused) :foreground fg)) +(defun focus-window-bounds () + (cons (window-start) (window-end nil t))) + +(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) "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 'default :foreground))) -(defun focus-undim-area (low high) +(defun focus-dim-area (low high) "Restore original colors between LOW and HIGH. Returns the list of added overlays." - (when (< low high) - (let* ((next (min high (or (next-property-change low) high))) - (face (get-text-property low 'face)) - (fg (focus-foreground-from-face face)) - (restored-face (focus-make-focused-face fg)) - (o (make-overlay low next))) - (overlay-put o 'face restored-face) - (cons o (focus-undim-area next high))))) + (while (< low high) + (let ((next (next-single-property-change low 'face nil high))) + (if (invisible-p low) + (setq low (next-single-char-property-change low 'invisible nil high)) + (let* ((face (get-text-property low 'face)) + (fg (focus-foreground-from-face face)) + (unfocused-face (focus-make-unfocused-face fg)) + (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'. -If `focus-mode' is enabled, this command fires after each -command." +If `focus-mode' is enabled, this function is added to +`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 - (let* ((bounds (focus-bounds)) - (bg (face-background 'default))) - (when (not (equal focus-last-background bg)) - (focus-dim-buffer)) + (let* ((bg (face-background 'default)) + (window-bounds (focus-window-bounds)) + (bounds (focus-bounds))) (when (and bounds (or (not (equal bg focus-last-background)) + (not (equal window-bounds focus-last-window-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))) - (focus-move-overlays low high) - (mapc 'delete-overlay focus-mid-overlays) - (setq focus-mid-overlays (focus-undim-area low high)))) - (setq focus-last-bounds bounds) - (setq focus-last-background bg)))) + (focus-remove-unfocused-overlays) + (focus-dim-area start low) + (focus-dim-area high end) + (move-overlay focus-focused-overlay low high))) + (setq focus-last-background bg) + (setq focus-last-window-bounds window-bounds) + (setq focus-last-bounds bounds)))) -(defun focus-move-overlays (low high) - "Move `focus-pre-overlay' and `focus-post-overlay'." - (move-overlay focus-pre-overlay (point-min) low) - (move-overlay focus-post-overlay high (point-max))) +(defun focus-make-focused-overlay () + (let ((o (make-overlay (point-min) (point-max)))) + (overlay-put o 'face 'focus-focused) + o)) (defun focus-init () "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-move-focus' runs. It adds `focus-move-focus' to `post-command-hook'." - (unless (or focus-pre-overlay focus-post-overlay) - (setq focus-pre-overlay (make-overlay (point-min) (point-min)) - focus-post-overlay (make-overlay (point-max) (point-max)) - focus-buffer (current-buffer)) - (overlay-put focus-pre-overlay 'face 'focus-unfocused) - (overlay-put focus-post-overlay 'face 'focus-unfocused) - (add-hook 'post-command-hook 'focus-move-focus t t) - (add-hook 'change-major-mode-hook 'focus-terminate t t) - (focus-move-focus))) + (focus-cleanup) + (setq focus-buffer (current-buffer)) + (setq focus-focused-overlay (focus-make-focused-overlay)) + (add-hook 'post-command-hook 'focus-move-focus t t) + (add-hook 'window-scroll-functions 'focus-move-focus t t) + (add-hook 'change-major-mode-hook 'focus-cleanup t t) + (focus-move-focus)) -(defun focus-terminate () +(defun focus-cleanup () "This function is run when command `focus-mode' is disabled. Overlays are deleted. `focus-move-focus' is removed from `post-command-hook'." - (let ((overlays (append (list focus-pre-overlay - focus-post-overlay) - focus-mid-overlays))) + (let ((overlays (cons focus-focused-overlay focus-unfocused-overlays))) (mapc (lambda (o) (and (overlayp o) (delete-overlay o))) overlays) (remove-hook 'post-command-hook 'focus-move-focus t) - (focus-reset-remapping) - (setq focus-pre-overlay nil - focus-post-overlay nil + (remove-hook 'window-scroll-functions 'focus-move-focus t) + (setq focus-unfocused-overlays nil + focus-focused-overlay nil focus-last-bounds nil focus-last-background nil))) @@ -261,16 +253,15 @@ default is overwritten. This function simply helps set the (defun focus-pin () "Pin the focused section to its current location or the region, if active." (interactive) - (when (bound-and-true-p focus-mode) - (when (region-active-p) - (focus-move-overlays (region-beginning) (region-end))) - (remove-hook 'post-command-hook 'focus-move-focus t))) + (when (and (bound-and-true-p focus-mode) + (region-active-p)) + (setq focus-pin-bounds (cons (region-beginning) (region-end))))) (defun focus-unpin () "Unpin the focused section." (interactive) (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) "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))) (define-key map (kbd "C-c C-q") 'focus-read-only-mode) map) - (if focus-mode (focus-init) (focus-terminate))) + (if focus-mode (focus-init) (focus-cleanup))) ;;;###autoload (define-minor-mode focus-read-only-mode