source: main/org-autofocus.el

;;; org-autofocus.el --- Mark Forster's Auto Focus system for Org  -*- lexical-binding: t; -*-

;; Copyright (C) 2020 David Owen

;; Author: David Owen <dsowen@fugue88.ws>
;; Keywords: autofocus
;; Package-Requires: (org)

;;; Commentary:

;; This minor mode works primarily by lightly analyzing the Org Agenda todo list
;; and adding some extra text properties, and by the addition of a TOUCHED
;; property to tasks' property drawers.
;;
;; Tasks are identified by looking at the beginning of a line for the TYPE
;; property that Org adds.  The code does /not/ verify that the property's value
;; is "todo".  It's assumed that a task runs from the beginning of a line to the
;; end of the same line.
;;
;; A task is "dotted" or "marked" by setting the DISPLAY properties of the first
;; character of the line to "*".
;;
;; A range of tasks is hidden by setting the INVISIBLE property of the entire
;; line to T.  Because this hides the newline, the range of hidden tasks
;; actually appears at the beginning of the line for the following unhidden
;; task; see ORG-AF--BEG-OF-TASK.
;;
;; A marked task is dimmed by adding an overlay with FACE set to
;; 'ORG-AGENDA-DIMMED-TODO-FACE.
;;
;; Properties are added as one property representing the state
;; (e.g. ORG-AF-MARKED) set to T for easy property testing, and the CATEGORY
;; property set to the state (e.g. 'ORG-AF-MARKED) to handle the actual visual
;; characteristics.  See variable ORG-AF-MARKED and following functions for an
;; example.
;;
;; Tasks are sorted according to the value of the TOUCHED property;
;; least-recently-touched tasks are followed by most-recently-touched tasks.
;; Any task that doesn't already have the property is touched at the time of
;; sorting.
;;
;; The user may mark a task by pressing "."; all tasks between it and the
;; previous marked task will be hidden, and all previous marked tasks dimmed.
;; The idea is that hidden and dimmed tasks are not to be manipulated any
;; further, until subsquent marked tasks have been handled in some way.
;;
;; The user may defer a task by pressing "d"; the task will be unmarked,
;; touched, and sorted to the end.
;;
;; Finally, the user may complete a task by pressing "c" or "t"; the task will
;; be unmarked, completed by Org's code, touched, and sorted to the end.

;;; Known issues:

;; Keymaps and commands are not sufficiently controlled.  A user may manipulate
;; a task in a way this minor mode doesn't handle.  A user may also manipulate
;; tasks that are dimmed.

;; Redo'ing the agenda loses the minor mode; it's necessary to run ORG-AUTOFOCUS
;; every time the minor mode is desired.

;; I haven't yet found a way to enable this minor mode without using a command
;; that wraps the call to ORG-AGENDA with some overriding bindings in place.
;; This is the primary reason that redo isn't supported.

;;; Code:

(require 'org-agenda)


(defvar org-af-marked 'org-af-marked)
(put 'org-af-marked 'org-af-marked t)
(put 'org-af-marked 'display "*")

(defun org-af--mark (point)
  "Mark the task at POINT."
  (let ((o (make-overlay point (1+ point))))
    (overlay-put o 'category org-af-marked)))

(defun org-af--unmark (point)
  "Unmark the task at POINT."
  (remove-overlays point (1+ point) org-af-marked t))

(defun org-af--marked-p (point)
  "Test whether the task at POINT is marked."
  (get-char-property point 'org-af-marked))


(defvar org-af-hidden 'org-af-hidden)
(put 'org-af-hidden 'org-af-hidden t)
(put 'org-af-hidden 'invisible t)


(defvar org-af-dimmed 'org-af-dimmed)
(put 'org-af-dimmed 'org-af-dimmed t)
(put 'org-af-dimmed 'face 'org-agenda-dimmed-todo-face)
(put 'org-af-dimmed 'evaporate t)

(defun org-af--dim (start end)
  "Dim the task from START to END."
  (let ((o (make-overlay start end)))
    (overlay-put o 'category org-af-dimmed)))

(defun org-af--undim (start end)
  "Undim the task from START to END."
  (remove-overlays start end 'org-af-dimmed t))

(defun org-af--dimmed-p (point)
  "Test whether the task at POINT is dimmed."
  (get-char-property point 'org-af-dimmed))


(defun org-af--beg-of-task ()
  "Move point to the beginning of the task at point.
Skips over any hidden tasks the are on the same line."
  (beginning-of-line)
  (when (get-text-property (point) 'org-af-hidden)
    (goto-char (next-single-property-change (point) 'org-af-hidden))))


(defun org-af--end-of-task (pos)
  "Return the position of the end of the task at POS (excluding end of line)."
  (next-single-property-change pos 'org-hd-marker))


(defun org-af--next-task (from-pos)
  "Return the position of the next visible task, from FROM-POS."
  (setf from-pos (next-single-property-change from-pos 'org-hd-marker))
  (while (eq (get-text-property from-pos 'org-todo-blocked) 'invisible)
    ;; The EOL doesn't have an ORG-HD-MARKER property, so search twice to skip
    ;; over it.
    (setf from-pos (next-single-property-change from-pos 'org-hd-marker)
          from-pos (next-single-property-change from-pos 'org-hd-marker)))
  from-pos)


(defun org-af--first-task ()
  "Return the position of the first visible task."
  (org-af--next-task 1))


(defun org-af--prev-mark (pos)
  "Return the position of the first mark previous to POS, or NIL if none are previous."
  (let* ((prev (previous-single-char-property-change pos 'org-af-marked)))
    (if (= prev 1)
        nil
      (1- prev))))


(defun org-af-mark ()
  "Mark or unmark the current task, dim the previous marked task if any, and hide any tasks between."
  (interactive)
  (org-af--beg-of-task)

  (let ((inhibit-read-only t)
        (task-point (point))
        marked)

    (unless (org-af--dimmed-p task-point)
      (setq marked (not (org-af--marked-p task-point)))
      (if marked
          (org-af--mark task-point)
        (org-af--unmark task-point))

      (save-excursion
        (let ((prev-marked (org-af--prev-mark task-point))
              hide-from)

          (cond
           (prev-marked
            (let ((eot (org-af--end-of-task prev-marked)))
              (if marked
                  (org-af--dim prev-marked eot)
                (org-af--undim prev-marked eot))
              (setf hide-from (org-af--next-task eot))))

           (t
            (setf hide-from (org-af--first-task))))

          (if marked
              (add-text-properties hide-from task-point
                                   '(category org-af-hidden))
            (remove-text-properties hide-from task-point
                                    '(category org-af-hidden))))))))


(defun org-af--timestamp ()
  "Return the current local time, with nanoseconds, formatted as an ISO string."
  (format-time-string "%Y-%m-%d %H:%M:%S.%N" (current-time)))


(defun org-af-defer ()
  "Defer the current task and update the display, unless NO-REDISPLAY."
  (interactive)
  (org-af--beg-of-task)
  (if (org-af--dimmed-p (point))
      (message "dimmed; skipping")
    (when (org-af--marked-p (point))
      (org-af-mark))

    ;; This comes from the guts of the org-agenda-set-property command.
    (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
                         (org-agenda-error)))
           (buffer (marker-buffer hdmarker))
           (pos (marker-position hdmarker))
           (inhibit-read-only t)
           (time (org-af--timestamp)))
      (org-with-remote-undo buffer
        (with-current-buffer buffer
          (widen)
          (goto-char pos)
          (org-show-context 'agenda)
          (org-set-property "TOUCHED" time))))

    (save-excursion
      (let* ((inhibit-read-only t)
             (text (delete-and-extract-region (point)
                                              (1+ (line-end-position)))))
        (goto-char (point-max))
        (insert text)))))


(defun org-af-complete ()
  "Complete to current task.
The task is unmarked (if marked), completed by Org, touched, then
sorted to the end of the list."
  (interactive)
  (org-af--beg-of-task)
  (when (org-af--marked-p (point))
    (org-af-mark))
  (org-agenda-todo)
  (org-af-defer))


(defvar org-autofocus-mode-map (make-sparse-keymap))
(define-key org-autofocus-mode-map "." 'org-af-mark)
(define-key org-autofocus-mode-map "d" 'org-af-defer)
(define-key org-autofocus-mode-map "c" 'org-af-complete)
(define-key org-autofocus-mode-map "t" 'org-af-complete)


(defun org-af--touched (entry)
  "Touch ENTRY by setting its ``TOUCHED'' property to the current time."
  (let* ((marker (get-text-property 0 'org-hd-marker entry))
         (touched (org-entry-get marker "TOUCHED")))
    (unless touched
      (setq touched (org-af--timestamp))
      (org-entry-put marker "TOUCHED" touched))
    touched))


(defun org-af--cmp (a b)
  "Compare A to B.
If A > B, return +1; if A < B, return -1; else, return NIL."
  (let* ((a-touched (org-af--touched a))
         (b-touched (org-af--touched b))
         (c (compare-strings a-touched nil nil b-touched nil nil)))
    (cond
     ((eq c t)  nil)
     ((< c 0)   -1)
     ((> c 0)   +1)
     (t (error "%S and %S compared as %S" a-touched b-touched c)))))


(define-minor-mode org-autofocus-mode nil nil " AF" org-autofocus-mode-map)


;;;###autoload
(defun org-autofocus ()
  "Display the Org Agenda Todo list in AutoFocus mode."
  (interactive)
  (let ((org-agenda-cmp-user-defined 'org-af--cmp)
        (org-agenda-sorting-strategy '(user-defined-up)))
    (org-agenda nil "t")
    (org-autofocus-mode)))


(provide 'org-autofocus)
;;; org-autofocus.el ends here