From 35ff92764a3c447c0c6af1ffafb1e2ef7d3e5150 Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Fri, 21 Feb 2020 22:45:27 +0100 Subject: [PATCH 01/13] Add special support for org mode --- focus.el | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/focus.el b/focus.el index 3485232..11556d6 100644 --- a/focus.el +++ b/focus.el @@ -31,6 +31,7 @@ ;;; Code: (require 'cl-lib) +(require 'org-element) (require 'thingatpt) (defgroup focus () @@ -38,7 +39,9 @@ :group 'font-lock :prefix "focus-") -(defcustom focus-mode-to-thing '((prog-mode . defun) (text-mode . sentence)) +(defcustom focus-mode-to-thing '((prog-mode . defun) + (text-mode . paragraph) + (org-mode . org-element)) "An associated list between mode and thing. A thing is defined in thingatpt.el; the thing determines the @@ -101,7 +104,13 @@ The timer calls `focus-read-only-hide-cursor' after (defun focus-bounds () "Return the current bounds, based on `focus-get-thing'." - (bounds-of-thing-at-point (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))) + (cons beg end))) + (t (bounds-of-thing-at-point (focus-get-thing)))))) (defun focus-move-focus () "Move the focused section according to `focus-bounds'. @@ -165,7 +174,7 @@ according to major-mode. If `focus-current-thing' is set, this default is overwritten. This function simply helps set the `focus-current-thing'." (interactive) - (let* ((candidates '(defun line list paragraph sentence sexp symbol word)) + (let* ((candidates '(defun line list org-element paragraph sentence sexp symbol word)) (thing (completing-read "Thing: " candidates))) (setq focus-current-thing (intern thing)))) From 933490c059747359920bc92fe4d961caba3f590b Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Sat, 22 Feb 2020 03:06:40 +0100 Subject: [PATCH 02/13] Dim the colors of the theme Fixes #2 --- focus.el | 123 ++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 95 insertions(+), 28 deletions(-) diff --git a/focus.el b/focus.el index 11556d6..0722884 100644 --- a/focus.el +++ b/focus.el @@ -31,6 +31,7 @@ ;;; Code: (require 'cl-lib) +(require 'face-remap) (require 'org-element) (require 'thingatpt) @@ -62,8 +63,12 @@ Things that are defined include `symbol', `list', `sexp', :type '(float) :group 'focus) -(defface focus-unfocused - '((t :inherit font-lock-comment-face)) +(defcustom focus-fraction 0.5 + "Determines the amount of dimness in out of focus sections (0.0 – 1.0)." + :type '(float) + :group 'focus) + +(defface focus-unfocused nil "The face that overlays the unfocused area." :group 'focus) @@ -83,17 +88,69 @@ Things that are defined include `symbol', `list', `sexp', (defvar-local focus-pre-overlay nil "The overlay that dims the text prior to the current-point.") -(defvar-local focus-mid-overlay nil - "The overlay that surrounds the text of the current-point.") - (defvar-local focus-post-overlay nil "The overlay that dims the text past the current-point.") +(defvar-local focus-mid-overlays nil) + +(defvar-local focus-remap-cookies nil) + +(defvar-local focus-last-bounds nil) + +(defvar-local focus-last-background nil) + (defvar-local focus-read-only-blink-timer nil "Timer started from `focus-read-only-cursor-blink'. The timer calls `focus-read-only-hide-cursor' after `focus-read-only-blink-seconds' seconds.") +(defun focus-lerp (c1 c2 d) + (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) + (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-dim-buffer () + ;; 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-reset-remapping () + (while focus-remap-cookies + (face-remap-remove-relative + (pop focus-remap-cookies)))) + +(defun focus-make-focused-face (fg) + (plist-put (face-attr-construct 'focus-focused) :foreground fg)) + +(defun focus-undim-area (low high) + (mapc 'delete-overlay focus-mid-overlays) + (setq focus-mid-overlays nil) + (save-excursion + (dotimes (i (- high low)) + (goto-char (+ low i)) + (let* ((prev (car focus-mid-overlays)) + (fg (foreground-color-at-point)) + (restored-face (focus-make-focused-face fg))) + (if (and (overlayp prev) + (equal restored-face (overlay-get prev 'face))) + (move-overlay prev (overlay-start prev) (1+ (overlay-end prev))) + (let ((o (make-overlay (+ low i) (+ low i 1)))) + (overlay-put o 'face restored-face) + (push o focus-mid-overlays))))))) + (defun focus-get-thing () "Return the current thing, based on `focus-mode-to-thing'." (or focus-current-thing @@ -110,7 +167,7 @@ The timer calls `focus-read-only-hide-cursor' after (beg (org-element-property :begin elem)) (end (org-element-property :end elem))) (cons beg end))) - (t (bounds-of-thing-at-point (focus-get-thing)))))) + (t (bounds-of-thing-at-point thing))))) (defun focus-move-focus () "Move the focused section according to `focus-bounds'. @@ -118,47 +175,57 @@ The timer calls `focus-read-only-hide-cursor' after If `focus-mode' is enabled, this command fires after each command." (with-current-buffer focus-buffer - (let* ((bounds (focus-bounds))) - (when bounds - (focus-move-overlays (car bounds) (cdr bounds)))))) + (let* ((bounds (focus-bounds)) + (bg (face-background 'default))) + (when (not (equal focus-last-background bg)) + (focus-dim-buffer)) + (when (and bounds + (or (not (equal bg focus-last-background)) + (not (equal bounds focus-last-bounds)))) + (let ((low (car bounds)) + (high (cdr bounds))) + (focus-move-overlays low high) + (focus-undim-area low high))) + (setq focus-last-bounds bounds) + (setq focus-last-background bg)))) (defun focus-move-overlays (low high) - "Move `focus-pre-overlay', `focus-mid-overlay' and `focus-post-overlay'." + "Move `focus-pre-overlay' and `focus-post-overlay'." (move-overlay focus-pre-overlay (point-min) low) - (move-overlay focus-mid-overlay low high) (move-overlay focus-post-overlay high (point-max))) (defun focus-init () - "This function is run when command `focus-mode' is enabled. + "This function runs when `focus-mode' is enabled. It sets the `focus-pre-overlay', `focus-min-overlay', and `focus-post-overlay' to overlays; these are invisible until -`focus-move-focus' is run. It adds `focus-move-focus' to +`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-mid-overlay (make-overlay (point-min) (point-max)) + (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-mid-overlay 'face 'focus-focused) - (mapc (lambda (o) (overlay-put o 'face 'focus-unfocused)) - (list focus-pre-overlay focus-post-overlay)) - (add-hook 'post-command-hook 'focus-move-focus nil t) - (add-hook 'change-major-mode-hook 'focus-terminate nil t))) + (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))) (defun focus-terminate () "This function is run when command `focus-mode' is disabled. -The overlays pointed to by `focus-pre-overlay', -`focus-mid-overlay' and `focus-post-overlay' are deleted, and -`focus-move-focus' is removed from `post-command-hook'." - (when (and focus-pre-overlay focus-post-overlay) - (mapc 'delete-overlay - (list focus-pre-overlay focus-mid-overlay focus-post-overlay)) +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))) + (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-mid-overlay nil - focus-post-overlay nil))) + focus-post-overlay nil + focus-last-bounds nil + focus-last-background nil))) (defun focus-goto-thing (bounds) "Move point to the middle of BOUNDS." From 83355a4f1cfe176b11389dc8a787e866b900d532 Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Sun, 23 Feb 2020 16:20:12 +0100 Subject: [PATCH 03/13] Document changes with remapping --- focus.el | 37 +++++++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 12 deletions(-) diff --git a/focus.el b/focus.el index 0722884..f464e24 100644 --- a/focus.el +++ b/focus.el @@ -91,13 +91,17 @@ Things that are defined include `symbol', `list', `sexp', (defvar-local focus-post-overlay nil "The overlay that dims the text past the current-point.") -(defvar-local focus-mid-overlays nil) +(defvar-local focus-mid-overlays nil + "These overlays restore original colors in the focused area.") -(defvar-local focus-remap-cookies nil) +(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'.") -(defvar-local focus-last-background nil) +(defvar-local focus-last-background nil + "Used to identify changes in the background.") (defvar-local focus-read-only-blink-timer nil "Timer started from `focus-read-only-cursor-blink'. @@ -105,10 +109,12 @@ 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)) @@ -118,24 +124,32 @@ The timer calls `focus-read-only-hide-cursor' after (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." ;; Most faces that alters the background are better left undimmed. The ;; default face is, however, a clear exception. + (focus-reset-remapping) (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-reset-remapping () - (while focus-remap-cookies - (face-remap-remove-relative - (pop focus-remap-cookies)))) - (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-undim-area (low high) + "Restore original colors in focused area. + +The number of overlays created is proportional to how many times +the foreground color changes between LOW and HIGH." (mapc 'delete-overlay focus-mid-overlays) (setq focus-mid-overlays nil) (save-excursion @@ -179,9 +193,8 @@ command." (bg (face-background 'default))) (when (not (equal focus-last-background bg)) (focus-dim-buffer)) - (when (and bounds - (or (not (equal bg focus-last-background)) - (not (equal bounds focus-last-bounds)))) + (when (and bounds (or (not (equal bg focus-last-background)) + (not (equal bounds focus-last-bounds)))) (let ((low (car bounds)) (high (cdr bounds))) (focus-move-overlays low high) From ee27db522aa9770b29dd83af56bc3c0e2cb267fe Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Sun, 23 Feb 2020 23:43:13 +0100 Subject: [PATCH 04/13] Change function for undimming focused area --- focus.el | 49 ++++++++++++++++++++++++------------------------- 1 file changed, 24 insertions(+), 25 deletions(-) diff --git a/focus.el b/focus.el index f464e24..4178bc2 100644 --- a/focus.el +++ b/focus.el @@ -141,30 +141,6 @@ The timer calls `focus-read-only-hide-cursor' after (face-foreground face)) (focus-remap-foreground-color-from-face face)))) -(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-undim-area (low high) - "Restore original colors in focused area. - -The number of overlays created is proportional to how many times -the foreground color changes between LOW and HIGH." - (mapc 'delete-overlay focus-mid-overlays) - (setq focus-mid-overlays nil) - (save-excursion - (dotimes (i (- high low)) - (goto-char (+ low i)) - (let* ((prev (car focus-mid-overlays)) - (fg (foreground-color-at-point)) - (restored-face (focus-make-focused-face fg))) - (if (and (overlayp prev) - (equal restored-face (overlay-get prev 'face))) - (move-overlay prev (overlay-start prev) (1+ (overlay-end prev))) - (let ((o (make-overlay (+ low i) (+ low i 1)))) - (overlay-put o 'face restored-face) - (push o focus-mid-overlays))))))) - (defun focus-get-thing () "Return the current thing, based on `focus-mode-to-thing'." (or focus-current-thing @@ -183,6 +159,28 @@ the foreground color changes between LOW and HIGH." (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-foreground-from-face (face) + "Return foreground color for FACE, or 'default if nil." + (if (facep face) + (face-attribute face :foreground) + (face-attribute 'default :foreground))) + +(defun focus-undim-area (low high) + "Restore original colors between LOW and HIGH. + +Returns the list of added overlays." + (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 (when (< low high) (focus-undim-area next high))))) + (defun focus-move-focus () "Move the focused section according to `focus-bounds'. @@ -198,7 +196,8 @@ command." (let ((low (car bounds)) (high (cdr bounds))) (focus-move-overlays low high) - (focus-undim-area 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)))) From 89a954d8d23fb4fd00eeada8464bc8187139cc40 Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Sun, 23 Feb 2020 23:44:14 +0100 Subject: [PATCH 05/13] Checkdoc --- focus.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/focus.el b/focus.el index 4178bc2..a870290 100644 --- a/focus.el +++ b/focus.el @@ -77,7 +77,7 @@ Things that are defined include `symbol', `list', `sexp', :group 'focus) (defvar focus-cursor-type cursor-type - "Used to restore the users `cursor-type'") + "Used to restore the users `cursor-type'.") (defvar-local focus-current-thing nil "Overrides the choice of thing dictated by `focus-mode-to-thing' if set.") @@ -207,7 +207,7 @@ command." (move-overlay focus-post-overlay high (point-max))) (defun focus-init () - "This function runs when `focus-mode' is enabled. + "This function run when command `focus-mode' is enabled. It sets the `focus-pre-overlay', `focus-min-overlay', and `focus-post-overlay' to overlays; these are invisible until From 4087bf62e6f7b8fd5b41981cc0537caaa6409019 Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Mon, 24 Feb 2020 00:17:23 +0100 Subject: [PATCH 06/13] Move comment --- focus.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/focus.el b/focus.el index a870290..a4774a3 100644 --- a/focus.el +++ b/focus.el @@ -132,9 +132,9 @@ The timer calls `focus-read-only-hide-cursor' after (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-reset-remapping) (focus-remap-foreground-color-from-face 'default) (dolist (face (face-list)) (when (and (not (face-background face)) From f82be0af42c7326482106077b852de9481b9f577 Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Mon, 24 Feb 2020 21:40:27 +0100 Subject: [PATCH 07/13] Check nils --- focus.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/focus.el b/focus.el index a4774a3..694131d 100644 --- a/focus.el +++ b/focus.el @@ -156,7 +156,7 @@ The timer calls `focus-read-only-hide-cursor' after (let* ((elem (org-element-at-point)) (beg (org-element-property :begin elem)) (end (org-element-property :end elem))) - (cons beg end))) + (and beg end (cons beg end)))) (t (bounds-of-thing-at-point thing))))) (defun focus-make-focused-face (fg) From af05a0166796ab8411f046c4ae2a5a717710e7f8 Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Mon, 24 Feb 2020 21:50:24 +0100 Subject: [PATCH 08/13] Move condition --- focus.el | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/focus.el b/focus.el index 694131d..69819ac 100644 --- a/focus.el +++ b/focus.el @@ -173,13 +173,14 @@ The timer calls `focus-read-only-hide-cursor' after "Restore original colors between LOW and HIGH. Returns the list of added overlays." - (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 (when (< low high) (focus-undim-area next high))))) + (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))))) (defun focus-move-focus () "Move the focused section according to `focus-bounds'. From 28b7662f2672b3aeccf9e6a43be1e98dc6db0e9f Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Sun, 8 Mar 2020 18:32:39 +0100 Subject: [PATCH 09/13] 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 From 6f7fbd35137f8850a9cc0e656739584c91daf9ac Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Sun, 8 Mar 2020 20:08:39 +0100 Subject: [PATCH 10/13] Improve org-mode support --- focus.el | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/focus.el b/focus.el index 44cad80..1d06cf7 100644 --- a/focus.el +++ b/focus.el @@ -116,16 +116,20 @@ The timer calls `focus-read-only-hide-cursor' after (apply #'derived-mode-p modes)))) (if mode (cdr (assoc mode focus-mode-to-thing)) 'sentence)))) +(defun focus-org-element-bounds () + "Extract bounds from `org-element-at-point'" + (let* ((elem (org-element-at-point)) + (beg (org-element-property :begin elem)) + (end (org-element-property :end elem))) + (and beg end (cons beg end)))) + +(put 'org-element 'bounds-of-thing-at-point + #'focus-org-element-bounds) + (defun focus-bounds () "Return the current bounds, based on `focus-get-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)))))) + (bounds-of-thing-at-point (focus-get-thing)))) (defun focus-window-bounds () (cons (window-start) (window-end nil t))) From 872f24cb26e645acb997089fa7aad709146e407f Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Sun, 8 Mar 2020 20:37:31 +0100 Subject: [PATCH 11/13] Simplify making a unfocused face --- focus.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/focus.el b/focus.el index 1d06cf7..ffba859 100644 --- a/focus.el +++ b/focus.el @@ -142,13 +142,13 @@ The timer calls `focus-read-only-hide-cursor' after (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 + (if (and fg bg (color-defined-p fg) (color-defined-p bg) + (not (color-defined-p (face-attribute 'focus-unfocused :foreground)))) (plist-put (face-attr-construct 'focus-unfocused) :foreground (focus-lerp (color-name-to-rgb fg) (color-name-to-rgb bg) - focus-fraction)))))) + focus-fraction)) + 'focus-unfocused))) (defun focus-foreground-from-face (face) "Return foreground color for FACE, or 'default if nil." From 9af4fbe6359eba7958d697e8d9036760f86c87d3 Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Sun, 8 Mar 2020 20:48:58 +0100 Subject: [PATCH 12/13] Don't recalculate while typing --- focus.el | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/focus.el b/focus.el index ffba859..672aad3 100644 --- a/focus.el +++ b/focus.el @@ -183,24 +183,25 @@ 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* ((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 ((start (car window-bounds)) - (end (cdr window-bounds)) - (low (car bounds)) - (high (cdr bounds))) - (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)))) + (while-no-input + (with-current-buffer focus-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 ((start (car window-bounds)) + (end (cdr window-bounds)) + (low (car bounds)) + (high (cdr bounds))) + (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-make-focused-overlay () (let ((o (make-overlay (point-min) (point-max)))) From 707eee02d641a6bc64e1e66c529a64d719faebc5 Mon Sep 17 00:00:00 2001 From: Lars Tveito Date: Mon, 9 Mar 2020 15:41:15 +0100 Subject: [PATCH 13/13] Fix "Unused lexical argument" warning --- focus.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/focus.el b/focus.el index 672aad3..4f6987f 100644 --- a/focus.el +++ b/focus.el @@ -176,12 +176,12 @@ Returns the list of added overlays." (while focus-unfocused-overlays (delete-overlay (pop focus-unfocused-overlays)))) -(defun focus-move-focus (&rest args) +(defun focus-move-focus (&rest _args) "Move the focused section according to `focus-bounds'. 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 +can be called with an arbitrary number of _ARGS to support being called from `window-scroll-functions'." (while-no-input (with-current-buffer focus-buffer