emacs/lisp/org/org-duration.el

466 lines
15 KiB
EmacsLisp
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; org-duration.el --- Library handling durations -*- lexical-binding: t; -*-
;; Copyright (C) 2017-2024 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, text
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides tools to manipulate durations. A duration
;; can have multiple formats:
;;
;; - 3:12
;; - 1:23:45
;; - 1y 3d 3h 4min
;; - 1d3h5min
;; - 3d 13:35
;; - 2.35h
;;
;; More accurately, it consists of numbers and units, as defined in
;; variable `org-duration-units', possibly separated with white
;; spaces, and an optional "H:MM" or "H:MM:SS" part, which always
;; comes last. White spaces are tolerated between the number and its
;; relative unit. Variable `org-duration-format' controls durations
;; default representation.
;;
;; The library provides functions allowing to convert a duration to,
;; and from, a number of minutes: `org-duration-to-minutes' and
;; `org-duration-from-minutes'. It also provides two lesser tools:
;; `org-duration-p', and `org-duration-h:mm-only-p'.
;;
;; Users can set the number of minutes per unit, or define new units,
;; in `org-duration-units'. The library also supports canonical
;; duration, i.e., a duration that doesn't depend on user's settings,
;; through optional arguments.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'org-macs)
;;; Public variables
(defconst org-duration-canonical-units
`(("min" . 1)
("h" . 60)
("d" . ,(* 60 24)))
"Canonical time duration units.
See `org-duration-units' for details.")
(defcustom org-duration-units
`(("min" . 1)
("h" . 60)
("d" . ,(* 60 24))
("w" . ,(* 60 24 7))
("m" . ,(* 60 24 30))
("y" . ,(* 60 24 365.25)))
"Conversion factor to minutes for a duration.
Each entry has the form (UNIT . MODIFIER).
In a duration string, a number followed by UNIT is multiplied by
the specified number of MODIFIER to obtain a duration in minutes.
For example, the following value
\\=`((\"min\" . 1)
(\"h\" . 60)
(\"d\" . ,(* 60 8))
(\"w\" . ,(* 60 8 5))
(\"m\" . ,(* 60 8 5 4))
(\"y\" . ,(* 60 8 5 4 10)))
is meaningful if you work an average of 8 hours per day, 5 days
a week, 4 weeks a month and 10 months a year.
When setting this variable outside the Customize interface, make
sure to call the following command:
\\[org-duration-set-regexps]"
:group 'org-agenda
:version "26.1"
:package-version '(Org . "9.1")
:set (lambda (var val)
(set-default-toplevel-value var val)
;; Avoid recursive load at startup.
(when (featurep 'org-duration)
(org-duration-set-regexps)))
:initialize 'custom-initialize-changed
:type '(choice
(const :tag "H:MM" h:mm)
(const :tag "H:MM:SS" h:mm:ss)
(alist :key-type (string :tag "Unit")
:value-type (number :tag "Modifier"))))
(defcustom org-duration-format '(("d" . nil) (special . h:mm))
"Format definition for a duration.
The value can be set to, respectively, the symbols `h:mm:ss' or
`h:mm', which means a duration is expressed as, respectively,
a \"H:MM:SS\" or \"H:MM\" string.
Alternatively, the value can be a list of entries following the
pattern:
(UNIT . REQUIRED?)
UNIT is a unit string, as defined in `org-duration-units'. The
time duration is formatted using only the time components that
are specified here.
Units with a zero value are skipped, unless REQUIRED? is non-nil.
In that case, the unit is always used.
The list can also contain one of the following special entries:
(special . h:mm)
(special . h:mm:ss)
Units shorter than an hour are ignored. The hours and
minutes part of the duration is expressed unconditionally
with H:MM, or H:MM:SS, pattern.
(special . PRECISION)
A duration is expressed with a single unit, PRECISION being
the number of decimal places to show. The unit chosen is the
first one required or with a non-zero integer part. If there
is no such unit, the smallest one is used.
Eventually, if the list contains the symbol `compact', the
duration is expressed in a compact form, without any white space
between units.
For example,
((\"d\" . nil) (\"h\" . t) (\"min\" . t))
means a duration longer than a day is expressed in days, hours
and minutes, whereas a duration shorter than a day is always
expressed in hours and minutes, even when shorter than an hour.
On the other hand, the value
((\"d\" . nil) (\"min\" . nil))
means a duration longer than a day is expressed in days and
minutes, whereas a duration shorter than a day is expressed
entirely in minutes, even when longer than an hour.
The following format
((\"d\" . nil) (special . h:mm))
means that any duration longer than a day is expressed with both
a \"d\" unit and a \"H:MM\" part, whereas a duration shorter than
a day is expressed only as a \"H:MM\" string.
Eventually,
((\"d\" . nil) (\"h\" . nil) (special . 2))
expresses a duration longer than a day as a decimal number, with
a 2-digits fractional part, of \"d\" unit. A duration shorter
than a day uses \"h\" unit instead."
:group 'org-time
:group 'org-clock
:package-version '(Org . "9.1")
:type '(choice
(const :tag "Use H:MM" h:mm)
(const :tag "Use H:MM:SS" h:mm:ss)
(repeat :tag "Use units"
(choice
(cons :tag "Use units"
(string :tag "Unit")
(choice (const :tag "Skip when zero" nil)
(const :tag "Always used" t)))
(cons :tag "Use a single decimal unit"
(const special)
(integer :tag "Number of decimals"))
(cons :tag "Use both units and H:MM"
(const special)
(const h:mm))
(cons :tag "Use both units and H:MM:SS"
(const special)
(const h:mm:ss))
(const :tag "Use compact form" compact)))))
;;; Internal variables and functions
(defconst org-duration--h:mm-re
"\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{1,2\\}[ \t]*\\'"
"Regexp matching a duration expressed with H:MM or H:MM:SS format.
See `org-duration--h:mm:ss-re' to only match the latter. Hours
can use any number of digits.")
(defconst org-duration--h:mm:ss-re
"\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{2\\}[ \t]*\\'"
"Regexp matching a duration expressed H:MM:SS format.
See `org-duration--h:mm-re' to also support H:MM format. Hours
can use any number of digits.")
(defvar org-duration--unit-re nil
"Regexp matching a duration with an unit.
Allowed units are defined in `org-duration-units'. Match group
1 contains the bare number. Match group 2 contains the unit.")
(defvar org-duration--full-re nil
"Regexp matching a duration expressed with units.
Allowed units are defined in `org-duration-units'.")
(defvar org-duration--mixed-re nil
"Regexp matching a duration expressed with units and H:MM or H:MM:SS format.
Allowed units are defined in `org-duration-units'. Match group
1 contains units part. Match group 2 contains H:MM or H:MM:SS
part.")
(defun org-duration--modifier (unit &optional canonical)
"Return modifier associated to string UNIT.
When optional argument CANONICAL is non-nil, refer to
`org-duration-canonical-units' instead of `org-duration-units'."
(or (cdr (assoc unit (if canonical
org-duration-canonical-units
org-duration-units)))
(error "Unknown unit: %S" unit)))
;;; Public functions
;;;###autoload
(defun org-duration-set-regexps ()
"Set duration related regexps."
(interactive)
(setq org-duration--unit-re
(concat "\\([0-9]+\\(?:\\.[0-9]*\\)?\\)[ \t]*"
;; Since user-defined units in `org-duration-units'
;; can differ from canonical units in
;; `org-duration-canonical-units', include both in
;; regexp.
(regexp-opt (mapcar #'car (append org-duration-canonical-units
org-duration-units))
t)))
(setq org-duration--full-re
(format "\\`\\(?:[ \t]*%s\\)+[ \t]*\\'" org-duration--unit-re))
(setq org-duration--mixed-re
(format "\\`\\(?1:\\([ \t]*%s\\)+\\)[ \t]*\
\\(?2:[0-9]+\\(?::[0-9][0-9]\\)\\{1,2\\}\\)[ \t]*\\'"
org-duration--unit-re)))
;;;###autoload
(defun org-duration-p (s)
"Non-nil when string S is a time duration."
(and (stringp s)
(or (string-match-p org-duration--full-re s)
(string-match-p org-duration--mixed-re s)
(string-match-p org-duration--h:mm-re s))))
;;;###autoload
(defun org-duration-to-minutes (duration &optional canonical)
"Return number of minutes of DURATION string.
When optional argument CANONICAL is non-nil, ignore
`org-duration-units' and use standard time units value.
A bare number is translated into minutes. The empty string is
translated into 0.0.
Return value as a float. Raise an error if duration format is
not recognized."
(save-match-data
(cond
((equal duration "") 0.0)
((numberp duration) (float duration))
((string-match-p org-duration--h:mm-re duration)
(pcase-let ((`(,hours ,minutes ,seconds)
(mapcar #'string-to-number (split-string duration ":"))))
(+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
((string-match-p org-duration--full-re duration)
(let ((minutes 0)
(s 0))
(while (string-match org-duration--unit-re duration s)
(setq s (match-end 0))
(let ((value (string-to-number (match-string 1 duration)))
(unit (match-string 2 duration)))
(cl-incf minutes (* value (org-duration--modifier unit canonical)))))
(float minutes)))
((string-match org-duration--mixed-re duration)
(let ((units-part (match-string 1 duration))
(hms-part (match-string 2 duration)))
(+ (org-duration-to-minutes units-part)
(org-duration-to-minutes hms-part))))
((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
(float (string-to-number duration)))
(t (error "Invalid duration format: %S" duration)))))
;;;###autoload
(defun org-duration-from-minutes (minutes &optional fmt canonical)
"Return duration string for a given number of MINUTES.
Format duration according to `org-duration-format' or FMT, when
non-nil.
When optional argument CANONICAL is non-nil, ignore
`org-duration-units' and use standard time units value.
Raise an error if expected format is unknown."
(if (< minutes 0) (concat "-" (org-duration-from-minutes (abs minutes) fmt canonical))
(pcase (or fmt org-duration-format)
(`h:mm
(format "%d:%02d" (/ minutes 60) (mod minutes 60)))
(`h:mm:ss
(let* ((whole-minutes (floor minutes))
(seconds (mod (* 60 minutes) 60)))
(format "%s:%02d"
(org-duration-from-minutes whole-minutes 'h:mm)
seconds)))
((pred atom) (error "Invalid duration format specification: %S" fmt))
;; Mixed format. Call recursively the function on both parts.
((and duration-format
(let `(special . ,(and mode (or `h:mm:ss `h:mm)))
(assq 'special duration-format)))
(let* ((truncated-format
;; Remove "special" mode from duration format in order to
;; recurse properly. Also remove units smaller or equal
;; to an hour since H:MM part takes care of it.
(cl-remove-if-not
(lambda (pair)
(pcase pair
(`(,(and unit (pred stringp)) . ,_)
(> (org-duration--modifier unit canonical) 60))
(_ nil)))
duration-format))
(min-modifier ;smallest modifier above hour
(and truncated-format
(apply #'min
(mapcar (lambda (p)
(org-duration--modifier (car p) canonical))
truncated-format)))))
(if (or (null min-modifier) (< minutes min-modifier))
;; There is not unit above the hour or the smallest unit
;; above the hour is too large for the number of minutes we
;; need to represent. Use H:MM or H:MM:SS syntax.
(org-duration-from-minutes minutes mode canonical)
;; Represent minutes above hour using provided units and H:MM
;; or H:MM:SS below.
(let* ((units-part (* min-modifier (/ (floor minutes) min-modifier)))
(minutes-part (- minutes units-part))
(compact (memq 'compact duration-format)))
(concat
(org-duration-from-minutes units-part truncated-format canonical)
(and (not compact) " ")
(org-duration-from-minutes minutes-part mode))))))
;; Units format.
(duration-format
(let* ((fractional
(let ((digits (cdr (assq 'special duration-format))))
(and digits
(or (wholenump digits)
(error "Unknown formatting directive: %S" digits))
(format "%%.%df" digits))))
(selected-units
(sort (cl-remove-if
;; Ignore special format cells and compact option.
(lambda (pair)
(pcase pair
((or `compact `(special . ,_)) t)
(_ nil)))
duration-format)
(lambda (a b)
(> (org-duration--modifier (car a) canonical)
(org-duration--modifier (car b) canonical)))))
(separator (if (memq 'compact duration-format) "" " ")))
(cond
;; Fractional duration: use first unit that is either required
;; or smaller than MINUTES.
(fractional
(let* ((unit (car
(or (cl-find-if
(lambda (pair)
(pcase pair
(`(,u . ,req?)
(or req?
(<= (org-duration--modifier u canonical)
minutes)))))
selected-units)
;; Fall back to smallest unit.
(org-last selected-units))))
(modifier (org-duration--modifier unit canonical)))
(concat (format fractional (/ (float minutes) modifier)) unit)))
;; Otherwise build duration string according to available
;; units.
((org-string-nw-p
(org-trim
(mapconcat
(lambda (units)
(pcase-let* ((`(,unit . ,required?) units)
(modifier (org-duration--modifier unit canonical)))
(cond ((<= modifier minutes)
(let ((value (floor minutes modifier)))
(cl-decf minutes (* value modifier))
(format "%s%d%s" separator value unit)))
(required? (concat separator "0" unit))
(t ""))))
selected-units
""))))
;; No unit can properly represent MINUTES. Use the smallest
;; one anyway.
(t
(pcase-let ((`((,unit . ,_)) (last selected-units)))
(concat "0" unit)))))))))
;;;###autoload
(defun org-duration-h:mm-only-p (times)
"Non-nil when every duration in TIMES has \"H:MM\" or \"H:MM:SS\" format.
TIMES is a list of duration strings.
Return nil if any duration is expressed with units, as defined in
`org-duration-units'. Otherwise, if any duration is expressed
with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
`h:mm'."
(let (hms-flag)
(catch :exit
(dolist (time times)
(cond ((string-match-p org-duration--full-re time)
(throw :exit nil))
((string-match-p org-duration--mixed-re time)
(throw :exit nil))
(hms-flag nil)
((string-match-p org-duration--h:mm:ss-re time)
(setq hms-flag 'h:mm:ss))))
(or hms-flag 'h:mm))))
;;; Initialization
(org-duration-set-regexps)
(provide 'org-duration)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; org-duration.el ends here