;;; org-urgency.el --- Smart, rules-based Org-agenda sorting  -*- lexical-binding: t; -*-

;; Copyright (C) 2025  Simon Parri

;; Author: Simon Parri <simonparri@ganzeria.com>
;; Keywords: calendar, outlines
;; Package-Requires: ((emacs "24.3") (compat "25.1") (org "9") (seq "1"))
;; URL: https://ba.ln.ea.cx/src/marsironpi/emacs/org-urgency
;; Version: 0.60

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This code implements something like Taskwarrior's urgency system for Org
;; Agenda.  It has nothing to do with the "urgency" system mentioned in the
;; Org manual.  The name is taken from Taskwarrior.

;; The general idea is that each entry will have a certain urgency, and the
;; urgency is calculated by summing the non-nil results of calling each
;; function in `org-urgency-functions'.  Currently the best way to learn how
;; to use the various urgency predicates is to read the source.  See also
;; `org-urgency-list' for a helper to make defining `org-urgency-functions'
;; slightly less verbose, and `org-urgency-define' for how to define your own
;; predicates.

;; Note on the naming scheme of the `org-urgency-by-' functions:

;; Functions ending in "?" or "=" will return the number passed to them if the
;; heading matches.  Functions not ending in "?" or "=" will use the number
;; passed to them to multiply the relevant value of the heading.
;; E.g. `org-urgency-by-state?' will return the number passed if the heading
;; is of the given state, whereas `org-urgency-by-effort' will multiply the
;; effort of the heading by the number passed, and return that.

;; Note on the values of the N argument to the `org-urgency-by-' functions:

;; Between two predicate functions, N values of the same order of magnitude
;; will produce urgencies of the same order of magnitude.  That is, if you
;; pass an N of 10 to `org-urgency-by-deadline' and an N of 10 to
;; `org-urgency-by-effort', you will get two urgencies of the same order of
;; magnitude.  (Any behavior to the contrary is a bug.)

;;; Code:

(require 'org)
(require 'cl-lib)

;;;###autoload
(defgroup org-urgency ()
  "Smart, rules-based Org-agenda sorting."
  :group 'org-agenda)

;;;###autoload
(defcustom org-urgency-functions ()
  "List of functions+arguments that determine the urgency of a given entry.

Each element in this list should be of the form

 (FUNC . POST-ARGS)

FUNC will be the function called, and it will be called with the first
argument being the heading in question (as passed to the function in
`org-agenda-cmp-user-defined'), and with POST-ARGS as the rest of the arguments.

If, then, `org-urgency-functions' were set to

 '((org-urgency-by-priority 10)
   (org-urgency-by-state? \"TODO\"))

then the urgency of a heading H would be equivalent to

 (apply #\\='+
        (seq-remove #\\='null
                    (list
                     (org-urgency-by-priority h 10)
                     (org-urgency-by-state? h \"TODO\" 10))))

See the definitions of the relevant `org-urgency-by-' functions for details.

Also see the function `org-urgency-list' for a shorthand way to assemble
an appropriate list for this variable."
  :type 'sexp)

(defun org-urgency--get (h prop)
  "Get PROP of H."
  (get-text-property 1 prop h))

;;;###autoload
(defmacro org-urgency-define (name args &rest body)
  "Define `org-urgency-by-NAME' as a function.

Its lambda-list will be `(H ,@ARGS N), and BODY is the body of the
function.  (H is the heading, as passed to
`org-agenda-cmp-user-defined', and N is the coefficient/number passed by
the user.)

Inside BODY, the function `get' is defined as a function that, given a
symbol, uses `org-urgency--get' to get the corresponding property from
H.

BODY should evaluate to a number, which will be added to the heading's
total urgency, or nil."
  (declare (indent 2)
           (doc-string 3))
  (let ((doc
         (when (stringp (car body))
           (pop body))))
    `(defun ,(intern (format "org-urgency-by-%s" name)) (h ,@args n)
       ,@(when doc (list doc))
       (cl-flet ((get (prop)
                   (org-urgency--get h prop)))
         ,@body))))

(org-urgency-define priority= (prio)
  "Urgency N when H has priority PRIO."
  (when (= (get 'priority)
           prio)
    n))

(org-urgency-define priority ()
  "Urgency is H's priority multiplied by N.

When N is 1, the urgency from this function is equal to the position of
the priority of H in the range between `org-priority-highest' and
`org-priority-lowest'.

E.g. if H has a priority of [#A] and `org-priority-highest' and
`org-priority-lowest' are ?A and ?C respectively, then when N is 1, H
will have an urgency of 2 according to this function."
  (* (/ (get 'priority) 1000) n))

(org-urgency-define scheduled? ()
  "Urgency N when H is scheduled."
  (when (org-get-scheduled-time (get 'org-marker))
    n))

(org-urgency-define scheduled-today? ()
  (when-let ((scheduled (org-get-scheduled-time (get 'org-marker)))
             (today? (= (time-to-days scheduled)
                        (org-today))))
    n))

(org-urgency-define deadline? ()
  "Urgency N when H is deadlined."
  (when (org-get-deadline-time (get 'org-marker))
    n))

(org-urgency-define near-deadline ()
  "Urgency is N times how close H is to its deadline.

If H has no deadline, this function contributes nothing.

When N is 1, the urgency from this function is equal to
`org-deadline-warning-days' minus the number of days till H's deadline."
  (when-let* ((deadline (org-get-deadline-time (get 'org-marker)))
              (remaining (time-to-number-of-days
                          (time-subtract
                           deadline (org-current-time))))
              (remaining (max remaining 0))
              (maximum org-deadline-warning-days)
              (coeff (- maximum remaining)))
    (* n coeff)))

(org-urgency-define timestamped-today? ()
  "Urgency N when H somehow appears today."
  (when-let* ((stamp (thread-first
                       (get 'org-marker)
                       (org-entry-get "TIMESTAMP")))
              (date (thread-first
                      (org-parse-time-string stamp)
                      (encode-time)
                      (time-to-days)))
              (today? (= date (org-today))))
    n))

(org-urgency-define tag? (tag)
  "Urgency N when H has tag TAG."
  (when (member tag (get 'tags))
    n))

(org-urgency-define habit? ()
  "Urgency N when H is a habit."
  (require 'org-habit)
  (when (org-is-habit-p (get 'org-marker))
    n))

(org-urgency-define state? (state)
  "Urgency N when H is in TODO state STATE."
  (when (equal (get 'todo-state) state)
    n))

(org-urgency-define effort ()
  "Urgency is the effort of H multiplied by N.

When N is 1, the urgency from this function is equal to the effort
estimate, in minutes."
  (* (or (get 'effort-minutes) 60.0) n))

(org-urgency-define random ()
  "Urgency is a random number between 0 and N.

The text of H, along with the date of the current agenda is used to seed
the random number.  The system PRNG seed is restored after this function
is called."
  (random (concat (format-time-string
                   "%Y %m %d %A "
                   org-agenda-current-date)
                  h))
  (prog1 (random n)
    (random t)))

;;;###autoload
(defun org-urgency-list (list)
  "Process LIST to make it a suitable value for `org-urgency-functions'.

LIST should be a list of lists whose `car' is a symbol and whose `cdr'
is a list of arguments.  An element such as

 (tag? \"@home\" 10)

will become

 (org-urgency-by-tag? \"@home\" 10)"
  (mapcar
   (lambda (x)
     (cons (intern (format "org-urgency-by-%s" (car x)))
           (cdr x)))
   list))

(defun org-urgency-calculate (h &optional keep-names)
  "Caluclate the urgencies of H.

If KEEP-NAMES is nil, simply return the list of urgency numbers.
Otherwise, return a list of pairs of function+arguments and
corresponding urgency number.

Uses `org-urgency-functions', which see."
  (thread-last
    org-urgency-functions
    (mapcar (lambda (x)
              (cl-destructuring-bind (f &rest args) x
                (if keep-names
                    (cons (cl-list* f 'h args) (apply f h args))
                  (apply f h args)))))
    (seq-remove #'null)))

(defun org-urgency-total (h)
  "Sum the various urgencies of H.

Urgencies are calculated by `org-urgency-calulate', which see."
  (if (not (equal (org-urgency--get h 'type) "diary"))
    (apply #'+ (org-urgency-calculate h))
    0))

;;;###autoload
(defun org-urgency-compare (a b)
  "Compare heading A to heading B.

This function is suitable as a value for `org-agenda-cmp-user-defined'."
  (let ((a (org-urgency-total a))
        (b (org-urgency-total b)))
    (cond ((> a b) +1)
          ((< a b) -1)
          (t nil))))

;;;###autoload
(defun org-urgency-show ()
  "Show a how the org-urgency rules apply to the current heading."
  (interactive nil org-agenda-mode)
  (unless (derived-mode-p '(org-agenda-mode))
    (user-error "Must be called in an Org-Agenda mode buffer"))
  (message
   "%s"
   (string-join
    (mapcar
     (lambda (x)
       (format "%S :: %s"
               (car x) (cdr x)))
     (org-urgency-calculate
      (org-current-line-string)
      t))
    "\n")))

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