lisp/org-duration.el

   1 ;;; org-duration.el --- Library handling durations   -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
   6 ;; Keywords: outlines, hypermedia, calendar, wp
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This library provides tools to manipulate durations.  A duration
  26 ;; can have multiple formats:
  27 ;;
  28 ;;   - 3:12
  29 ;;   - 1:23:45
  30 ;;   - 1y 3d 3h 4min
  31 ;;   - 3d 13:35
  32 ;;   - 2.35h
  33 ;;
  34 ;; More accurately, it consists of numbers and units, as defined in
  35 ;; variable `org-duration-units', separated with white spaces, and
  36 ;; a "H:MM" or "H:MM:SS" part.  White spaces are tolerated between the
  37 ;; number and its relative unit.  Variable `org-duration-format'
  38 ;; controls durations default representation.
  39 ;;
  40 ;; The library provides functions allowing to convert a duration to,
  41 ;; and from, a number of minutes: `org-duration-to-minutes' and
  42 ;; `org-duration-from-minutes'.  It also provides two lesser tools:
  43 ;; `org-duration-p', and `org-duration-h:mm-only-p'.
  44 ;;
  45 ;; Users can set the number of minutes per unit, or define new units,
  46 ;; in `org-duration-units'.  The library also supports canonical
  47 ;; duration, i.e., a duration that doesn't depend on user's settings,
  48 ;; through optional arguments.
  49
  50 ;;; Code:
  51
  52 (require 'cl-lib)
  53 (require 'org-macs)
  54 (declare-function org-trim "org-trim" (s &optional keep-lead))
  55
  56 \f
  57 ;;; Public variables
  58
  59 (defconst org-duration-canonical-units
  60   `(("min" . 1)
  61     ("h" . 60)
  62     ("d" . ,(* 60 24)))
  63   "Canonical time duration units.
  64 See `org-duration-units' for details.")
  65
  66 (defcustom org-duration-units
  67   `(("min" . 1)
  68     ("h" . 60)
  69     ("d" . ,(* 60 24))
  70     ("w" . ,(* 60 24 7))
  71     ("m" . ,(* 60 24 30))
  72     ("y" . ,(* 60 24 365.25)))
  73   "Conversion factor to minutes for a duration.
  74
  75 Each entry has the form (UNIT . MODIFIER).
  76
  77 In a duration string, a number followed by UNIT is multiplied by
  78 the specified number of MODIFIER to obtain a duration in minutes.
  79
  80 For example, the following value
  81
  82   \\=`((\"min\" . 1)
  83     (\"h\" . 60)
  84     (\"d\" . ,(* 60 8))
  85     (\"w\" . ,(* 60 8 5))
  86     (\"m\" . ,(* 60 8 5 4))
  87     (\"y\" . ,(* 60 8 5 4 10)))
  88
  89 is meaningful if you work an average of 8 hours per day, 5 days
  90 a week, 4 weeks a month and 10 months a year.
  91
  92 When setting this variable outside the Customize interface, make
  93 sure to call the following command:
  94
  95   \\[org-duration-set-regexps]"
  96   :group 'org-agenda
  97   :version "26.1"
  98   :package-version '(Org . "9.1")
  99   :set (lambda (var val) (set-default var val) (org-duration-set-regexps))
 100   :initialize 'custom-initialize-changed
 101   :type '(choice
 102           (const :tag "H:MM" 'h:mm)
 103           (const :tag "H:MM:SS" 'h:mm:ss)
 104           (alist :key-type (string :tag "Unit")
 105                  :value-type (number :tag "Modifier"))))
 106
 107 (defcustom org-duration-format '(("d" . nil) (special . h:mm))
 108   "Format definition for a duration.
 109
 110 The value can be set to, respectively, the symbols `h:mm:ss' or
 111 `h:mm', which means a duration is expressed as, respectively,
 112 a \"H:MM:SS\" or \"H:MM\" string.
 113
 114 Alternatively, the value can be a list of entries following the
 115 pattern:
 116
 117   (UNIT . REQUIRED?)
 118
 119 UNIT is a unit string, as defined in `org-duration-units'.  The
 120 time duration is formatted using only the time components that
 121 are specified here.
 122
 123 Units with a zero value are skipped, unless REQUIRED? is non-nil.
 124 In that case, the unit is always used.
 125
 126 Eventually, the list can contain one of the following special
 127 entries:
 128
 129   (special . h:mm)
 130   (special . h:mm:ss)
 131
 132     Units shorter than an hour are ignored.  The hours and
 133     minutes part of the duration is expressed unconditionally
 134     with H:MM, or H:MM:SS, pattern.
 135
 136   (special . PRECISION)
 137
 138     A duration is expressed with a single unit, PRECISION being
 139     the number of decimal places to show.  The unit chosen is the
 140     first one required or with a non-zero integer part.  If there
 141     is no such unit, the smallest one is used.
 142
 143 For example,
 144
 145    ((\"d\" . nil) (\"h\" . t) (\"min\" . t))
 146
 147 means a duration longer than a day is expressed in days, hours
 148 and minutes, whereas a duration shorter than a day is always
 149 expressed in hours and minutes, even when shorter than an hour.
 150
 151 On the other hand, the value
 152
 153   ((\"d\" . nil) (\"min\" . nil))
 154
 155 means a duration longer than a day is expressed in days and
 156 minutes, whereas a duration shorter than a day is expressed
 157 entirely in minutes, even when longer than an hour.
 158
 159 The following format
 160
 161   ((\"d\" . nil) (special . h:mm))
 162
 163 means that any duration longer than a day is expressed with both
 164 a \"d\" unit and a \"H:MM\" part, whereas a duration shorter than
 165 a day is expressed only as a \"H:MM\" string.
 166
 167 Eventually,
 168
 169   ((\"d\" . nil) (\"h\" . nil) (special . 2))
 170
 171 expresses a duration longer than a day as a decimal number, with
 172 a 2-digits fractional part, of \"d\" unit.  A duration shorter
 173 than a day uses \"h\" unit instead."
 174   :group 'org-time
 175   :group 'org-clock
 176   :version "26.1"
 177   :package-version '(Org . "9.1")
 178   :type '(choice
 179           (const :tag "Use H:MM" h:mm)
 180           (const :tag "Use H:MM:SS" h:mm:ss)
 181           (repeat :tag "Use units"
 182                   (choice
 183                    (cons :tag "Use units"
 184                          (string :tag "Unit")
 185                          (choice (const :tag "Skip when zero" nil)
 186                                  (const :tag "Always used" t)))
 187                    (cons :tag "Use a single decimal unit"
 188                          (const special)
 189                          (integer :tag "Number of decimals"))
 190                    (cons :tag "Use both units and H:MM"
 191                          (const special)
 192                          (const h:mm))
 193                    (cons :tag "Use both units and H:MM:SS"
 194                          (const special)
 195                          (const h:mm:ss))))))
 196
 197 \f
 198 ;;; Internal variables and functions
 199
 200 (defconst org-duration--h:mm-re
 201   "\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{1,2\\}[ \t]*\\'"
 202   "Regexp matching a duration expressed with H:MM or H:MM:SS format.
 203 See `org-duration--h:mm:ss-re' to only match the latter.  Hours
 204 can use any number of digits.")
 205
 206 (defconst org-duration--h:mm:ss-re
 207   "\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{2\\}[ \t]*\\'"
 208   "Regexp matching a duration expressed H:MM:SS format.
 209 See `org-duration--h:mm-re' to also support H:MM format.  Hours
 210 can use any number of digits.")
 211
 212 (defvar org-duration--unit-re nil
 213   "Regexp matching a duration with an unit.
 214 Allowed units are defined in `org-duration-units'.  Match group
 215 1 contains the bare number.  Match group 2 contains the unit.")
 216
 217 (defvar org-duration--full-re nil
 218   "Regexp matching a duration expressed with units.
 219 Allowed units are defined in `org-duration-units'.")
 220
 221 (defvar org-duration--mixed-re nil
 222   "Regexp matching a duration expressed with units and H:MM or H:MM:SS format.
 223 Allowed units are defined in `org-duration-units'.  Match group
 224 1 contains units part.  Match group 2 contains H:MM or H:MM:SS
 225 part.")
 226
 227 (defun org-duration--modifier (unit &optional canonical)
 228   "Return modifier associated to string UNIT.
 229 When optional argument CANONICAL is non-nil, refer to
 230 `org-duration-canonical-units' instead of `org-duration-units'."
 231   (or (cdr (assoc unit (if canonical
 232                            org-duration-canonical-units
 233                          org-duration-units)))
 234       (error "Unknown unit: %S" unit)))
 235
 236 \f
 237 ;;; Public functions
 238
 239 ;;;###autoload
 240 (defun org-duration-set-regexps ()
 241   "Set duration related regexps."
 242   (interactive)
 243   (setq org-duration--unit-re
 244         (concat "\\([0-9]+\\(?:\\.[0-9]*\\)?\\)[ \t]*"
 245                 ;; Since user-defined units in `org-duration-units'
 246                 ;; can differ from canonical units in
 247                 ;; `org-duration-canonical-units', include both in
 248                 ;; regexp.
 249                 (regexp-opt (mapcar #'car (append org-duration-canonical-units
 250                                                   org-duration-units))
 251                             t)))
 252   (setq org-duration--full-re
 253         (format "\\`[ \t]*%s\\(?:[ \t]+%s\\)*[ \t]*\\'"
 254                 org-duration--unit-re
 255                 org-duration--unit-re))
 256   (setq org-duration--mixed-re
 257         (format "\\`[ \t]*\\(?1:%s\\(?:[ \t]+%s\\)*\\)[ \t]+\
 258 \\(?2:[0-9]+\\(?::[0-9][0-9]\\)\\{1,2\\}\\)[ \t]*\\'"
 259                 org-duration--unit-re
 260                 org-duration--unit-re)))
 261
 262 ;;;###autoload
 263 (defun org-duration-p (s)
 264   "Non-nil when string S is a time duration."
 265   (and (stringp s)
 266        (or (string-match-p org-duration--full-re s)
 267            (string-match-p org-duration--mixed-re s)
 268            (string-match-p org-duration--h:mm-re s))))
 269
 270 ;;;###autoload
 271 (defun org-duration-to-minutes (duration &optional canonical)
 272   "Return number of minutes of DURATION string.
 273
 274 When optional argument CANONICAL is non-nil, ignore
 275 `org-duration-units' and use standard time units value.
 276
 277 A bare number is translated into minutes.  The empty string is
 278 translated into 0.0.
 279
 280 Return value as a float.  Raise an error if duration format is
 281 not recognized."
 282   (cond
 283    ((equal duration "") 0.0)
 284    ((numberp duration) (float duration))
 285    ((string-match-p org-duration--h:mm-re duration)
 286     (pcase-let ((`(,hours ,minutes ,seconds)
 287                  (mapcar #'string-to-number (split-string duration ":"))))
 288       (+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
 289    ((string-match-p org-duration--full-re duration)
 290     (let ((minutes 0)
 291           (s 0))
 292       (while (string-match org-duration--unit-re duration s)
 293         (setq s (match-end 0))
 294         (let ((value (string-to-number (match-string 1 duration)))
 295               (unit (match-string 2 duration)))
 296           (cl-incf minutes (* value (org-duration--modifier unit canonical)))))
 297       (float minutes)))
 298    ((string-match org-duration--mixed-re duration)
 299     (let ((units-part (match-string 1 duration))
 300           (hms-part (match-string 2 duration)))
 301       (+ (org-duration-to-minutes units-part)
 302          (org-duration-to-minutes hms-part))))
 303    ((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
 304     (float (string-to-number duration)))
 305    (t (error "Invalid duration format: %S" duration))))
 306
 307 ;;;###autoload
 308 (defun org-duration-from-minutes (minutes &optional fmt canonical)
 309   "Return duration string for a given number of MINUTES.
 310
 311 Format duration according to `org-duration-format' or FMT, when
 312 non-nil.
 313
 314 When optional argument CANONICAL is non-nil, ignore
 315 `org-duration-units' and use standard time units value.
 316
 317 Raise an error if expected format is unknown."
 318   (pcase (or fmt org-duration-format)
 319     (`h:mm
 320      (let ((minutes (floor minutes)))
 321        (format "%d:%02d" (/ minutes 60) (mod minutes 60))))
 322     (`h:mm:ss
 323      (let* ((whole-minutes (floor minutes))
 324             (seconds (floor (* 60 (- minutes whole-minutes)))))
 325        (format "%s:%02d"
 326                (org-duration-from-minutes whole-minutes 'h:mm)
 327                seconds)))
 328     ((pred atom) (error "Invalid duration format specification: %S" fmt))
 329     ;; Mixed format.  Call recursively the function on both parts.
 330     ((and duration-format
 331           (let `(special . ,(and mode (or `h:mm:ss `h:mm)))
 332             (assq 'special duration-format)))
 333      (let* ((truncated-format
 334              ;; Remove "special" mode from duration format in order to
 335              ;; recurse properly.  Also remove units smaller or equal
 336              ;; to an hour since H:MM part takes care of it.
 337              (cl-remove-if-not
 338               (lambda (pair)
 339                 (pcase pair
 340                   (`(,(and unit (pred stringp)) . ,_)
 341                    (> (org-duration--modifier unit canonical) 60))
 342                   (_ nil)))
 343               duration-format))
 344             (min-modifier               ;smallest modifier above hour
 345              (and truncated-format
 346                   (apply #'min
 347                          (mapcar (lambda (p)
 348                                    (org-duration--modifier (car p) canonical))
 349                                  truncated-format)))))
 350        (if (or (null min-modifier) (< minutes min-modifier))
 351            ;; There is not unit above the hour or the smallest unit
 352            ;; above the hour is too large for the number of minutes we
 353            ;; need to represent.  Use H:MM or H:MM:SS syntax.
 354            (org-duration-from-minutes minutes mode canonical)
 355          ;; Represent minutes above hour using provided units and H:MM
 356          ;; or H:MM:SS below.
 357          (let* ((units-part (* min-modifier (/ (floor minutes) min-modifier)))
 358                 (minutes-part (- minutes units-part)))
 359            (concat
 360             (org-duration-from-minutes units-part truncated-format canonical)
 361             " "
 362             (org-duration-from-minutes minutes-part mode))))))
 363     ;; Units format.
 364     (duration-format
 365      (let* ((fractional
 366              (let ((digits (cdr (assq 'special duration-format))))
 367                (and digits
 368                     (or (wholenump digits)
 369                         (error "Unknown formatting directive: %S" digits))
 370                     (format "%%.%df" digits))))
 371             (selected-units
 372              (sort (cl-remove-if
 373                     ;; Ignore special format cells.
 374                     (lambda (pair) (pcase pair (`(special . ,_) t) (_ nil)))
 375                     duration-format)
 376                    (lambda (a b)
 377                      (> (org-duration--modifier (car a) canonical)
 378                         (org-duration--modifier (car b) canonical))))))
 379        (cond
 380         ;; Fractional duration: use first unit that is either required
 381         ;; or smaller than MINUTES.
 382         (fractional
 383          (let* ((unit (car
 384                        (or (cl-find-if
 385                             (lambda (pair)
 386                               (pcase pair
 387                                 (`(,u . ,req?)
 388                                  (or req?
 389                                      (<= (org-duration--modifier u canonical)
 390                                          minutes)))))
 391                             selected-units)
 392                            ;; Fall back to smallest unit.
 393                            (org-last selected-units))))
 394                 (modifier (org-duration--modifier unit canonical)))
 395            (concat (format fractional (/ (float minutes) modifier)) unit)))
 396         ;; Otherwise build duration string according to available
 397         ;; units.
 398         ((org-string-nw-p
 399           (org-trim
 400            (mapconcat
 401             (lambda (units)
 402               (pcase-let* ((`(,unit . ,required?) units)
 403                            (modifier (org-duration--modifier unit canonical)))
 404                 (cond ((<= modifier minutes)
 405                        (let ((value (if (integerp modifier)
 406                                         (/ (floor minutes) modifier)
 407                                       (floor (/ minutes modifier)))))
 408                          (cl-decf minutes (* value modifier))
 409                          (format " %d%s" value unit)))
 410                       (required? (concat " 0" unit))
 411                       (t ""))))
 412             selected-units
 413             ""))))
 414         ;; No unit can properly represent MINUTES.  Use the smallest
 415         ;; one anyway.
 416         (t
 417          (pcase-let ((`((,unit . ,_)) (last selected-units)))
 418            (concat "0" unit))))))))
 419
 420 ;;;###autoload
 421 (defun org-duration-h:mm-only-p (times)
 422   "Non-nil when every duration in TIMES has \"H:MM\" or \"H:MM:SS\" format.
 423
 424 TIMES is a list of duration strings.
 425
 426 Return nil if any duration is expressed with units, as defined in
 427 `org-duration-units'.  Otherwise, if any duration is expressed
 428 with \"H:MM:SS\" format, return `h:mm:ss'.  Otherwise, return
 429 `h:mm'."
 430   (let (hms-flag)
 431     (catch :exit
 432       (dolist (time times)
 433         (cond ((string-match-p org-duration--full-re time)
 434                (throw :exit nil))
 435               ((string-match-p org-duration--mixed-re time)
 436                (throw :exit nil))
 437               (hms-flag nil)
 438               ((string-match-p org-duration--h:mm:ss-re time)
 439                (setq hms-flag 'h:mm:ss))))
 440       (or hms-flag 'h:mm))))
 441
 442 \f
 443 ;;; Initialization
 444
 445 (org-duration-set-regexps)
 446
 447 (provide 'org-duration)
 448 ;;; org-duration.el ends here