mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-11-21 06:55:35 +00:00
e0815d7545
; Add 2023 to copyright years. cae528457cb862dc886a34240c9d4c73035b6659 Eli Zaretskii Sun Jan 1 05:31:12 2023 -0500
465 lines
15 KiB
EmacsLisp
465 lines
15 KiB
EmacsLisp
;;; org-duration.el --- Library handling durations -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2017-2023 Free Software Foundation, Inc.
|
||
|
||
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
|
||
;; Keywords: outlines, hypermedia, calendar, wp
|
||
|
||
;; 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."
|
||
(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
|