diff --git a/focus.el b/focus.el index 8bc4704..d392ab0 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 @@ -59,8 +62,12 @@ Things that are defined include `symbol', `list', `sexp', :type 'number :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) @@ -69,7 +76,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.") @@ -77,20 +84,30 @@ 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-mid-overlay nil - "The overlay that surrounds the text of the current-point.") +(defvar-local focus-focused-overlay nil + "The overlay that is added to the focused area.") -(defvar-local focus-post-overlay nil - "The overlay that dims the text past the current-point.") +(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.") (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-get-thing () "Return the current thing, based on `focus-mode-to-thing'." (or focus-current-thing @@ -99,57 +116,126 @@ 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'." - (bounds-of-thing-at-point (focus-get-thing))) + (or focus-pin-bounds + (bounds-of-thing-at-point (focus-get-thing)))) -(defun focus-move-focus () +(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))) + (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-unfocused))) + +(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-dim-area (low high) + "Restore original colors between LOW and HIGH. + +Returns the list of added overlays." + (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-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." - (with-current-buffer focus-buffer - (let* ((bounds (focus-bounds))) - (when bounds - (focus-move-overlays (car bounds) (cdr 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 +called from `window-scroll-functions'." + (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-move-overlays (low high) - "Move `focus-pre-overlay', `focus-mid-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-make-focused-overlay () + (let ((o (make-overlay (point-min) (point-max)))) + (overlay-put o 'face 'focus-focused) + o)) (defun focus-init () - "This function is run when command `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 -`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)) - 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))) + (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. -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 (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) - (setq focus-pre-overlay nil - focus-mid-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))) (defun focus-goto-thing (bounds) "Move point to the middle of BOUNDS." @@ -165,23 +251,22 @@ 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)))) (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." @@ -256,7 +341,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