lisp/org-duration.el

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