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 (defvar org-duration--h:mm-re "\\`[0-9]+\\(?::[0-9]\\{2\\}\\)\\{1,2\\}\\'"
 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 (defvar org-duration--h:mm:ss-re "\\`[0-9]+\\(?::[0-9]\\{2\\}\\)\\{2\\}\\'"
 207   "Regexp matching a duration expressed H:MM:SS format.
 208 See `org-duration--h:mm-re' to also support H:MM format.  Hours
 209 can use any number of digits.")
 210
 211 (defvar org-duration--unit-re nil
 212   "Regexp matching a duration with an unit.
 213 Allowed units are defined in `org-duration-units'.  Match group
 214 1 contains the bare number.  Match group 2 contains the unit.")
 215
 216 (defvar org-duration--full-re nil
 217   "Regexp matching a duration expressed with units.
 218 Allowed units are defined in `org-duration-units'.")
 219
 220 (defvar org-duration--mixed-re nil
 221   "Regexp matching a duration expressed with units and H:MM or H:MM:SS format.
 222 Allowed units are defined in `org-duration-units'.  Match group
 223 1 contains units part.  Match group 2 contains H:MM or H:MM:SS
 224 part.")
 225
 226 (defun org-duration--modifier (unit &optional canonical)
 227   "Return modifier associated to string UNIT.
 228 When optional argument CANONICAL is non-nil, refer to
 229 `org-duration-canonical-units' instead of `org-duration-units'."
 230   (or (cdr (assoc unit (if canonical
 231                            org-duration-canonical-units
 232                          org-duration-units)))
 233       (error "Unknown unit: %S" unit)))
 234
 235 \f
 236 ;;; Public functions
 237
 238 ;;;###autoload
 239 (defun org-duration-set-regexps ()
 240   "Set duration related regexps."
 241   (interactive)
 242   (setq org-duration--unit-re
 243         (concat "\\([0-9]+\\(?:\\.[0-9]*\\)?\\)[ \t]*"
 244                 ;; Since user-defined units in `org-duration-units'
 245                 ;; can differ from canonical units in
 246                 ;; `org-duration-canonical-units', include both in
 247                 ;; regexp.
 248                 (regexp-opt (mapcar #'car (append org-duration-canonical-units
 249                                                   org-duration-units))
 250                             t)))
 251   (setq org-duration--full-re
 252         (format "\\`%s\\(?:[ \t]+%s\\)*\\'"
 253                 org-duration--unit-re
 254                 org-duration--unit-re))
 255   (setq org-duration--mixed-re
 256         (format "\\`\\(?1:%s\\(?:[ \t]+%s\\)*\\)[ \t]+\
 257 \\(?2:[0-9]+\\(?::[0-9][0-9]\\)\\{1,2\\}\\)\\'"
 258                 org-duration--unit-re
 259                 org-duration--unit-re)))
 260
 261 ;;;###autoload
 262 (defun org-duration-p (s)
 263   "Non-nil when string S is a time duration."
 264   (and (stringp s)
 265        (or (string-match-p org-duration--full-re s)
 266            (string-match-p org-duration--mixed-re s)
 267            (string-match-p org-duration--h:mm-re s))))
 268
 269 ;;;###autoload
 270 (defun org-duration-to-minutes (duration &optional canonical)
 271   "Return number of minutes of DURATION string.
 272
 273 When optional argument CANONICAL is non-nil, ignore
 274 `org-duration-units' and use standard time units value.
 275
 276 As a special case, a bare number represents minutes.
 277
 278 Return value as a float.  Raise an error if duration format is
 279 not recognized."
 280   (cond
 281    ((string-match-p org-duration--h:mm-re duration)
 282     (pcase-let ((`(,hours ,minutes ,seconds)
 283                  (mapcar #'string-to-number (split-string duration ":"))))
 284       (+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
 285    ((string-match-p org-duration--full-re duration)
 286     (let ((minutes 0)
 287           (s -1))
 288       (while (setq s (string-match org-duration--unit-re duration (1+ s)))
 289         (let ((value (string-to-number (match-string 1 duration)))
 290               (unit (match-string 2 duration)))
 291           (cl-incf minutes (* value (org-duration--modifier unit canonical)))))
 292       (float minutes)))
 293    ((string-match org-duration--mixed-re duration)
 294     (let ((units-part (match-string 1 duration))
 295           (hms-part (match-string 2 duration)))
 296       (+ (org-duration-to-minutes units-part)
 297          (org-duration-to-minutes hms-part))))
 298    ((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
 299     (float (string-to-number duration)))
 300    (t (error "Invalid duration format: %S" duration))))
 301
 302 ;;;###autoload
 303 (defun org-duration-from-minutes (minutes &optional fmt canonical)
 304   "Return duration string for a given number of MINUTES.
 305
 306 Format duration according to `org-duration-format' or FMT, when
 307 non-nil.
 308
 309 When optional argument CANONICAL is non-nil, ignore
 310 `org-duration-units' and use standard time units value.
 311
 312 Raise an error if expected format is unknown."
 313   (pcase (or fmt org-duration-format)
 314     (`h:mm
 315      (let ((minutes (floor minutes)))
 316        (format "%d:%02d" (/ minutes 60) (mod minutes 60))))
 317     (`h:mm:ss
 318      (let ((seconds (floor (* 60 minutes)) ))
 319        (format "%s:%02d"
 320                (org-duration-from-minutes (/ seconds 60) 'h:mm)
 321                (mod seconds 60))))
 322     ((pred atom) (error "Invalid duration format specification: %S" fmt))
 323     ;; Mixed format.  Call recursively the function on both parts.
 324     ((and duration-format
 325           (let `(special . ,(and mode (or `h:mm:ss `h:mm)))
 326             (assq 'special duration-format)))
 327      (let* ((truncated-format
 328              ;; Remove "special" mode from duration format in order to
 329              ;; recurse properly.  Also remove units smaller or equal
 330              ;; to an hour since H:MM part takes care of it.
 331              (cl-remove-if-not
 332               (lambda (pair)
 333                 (pcase pair
 334                   (`(,(and unit (pred stringp)) . ,_)
 335                    (> (org-duration--modifier unit canonical) 60))
 336                   (_ nil)))
 337               duration-format))
 338             (min-modifier               ;smallest modifier above hour
 339              (and truncated-format
 340                   (apply #'min
 341                          (mapcar (lambda (p)
 342                                    (org-duration--modifier (car p) canonical))
 343                                  truncated-format)))))
 344        (if (or (null min-modifier) (< minutes min-modifier))
 345            ;; There is not unit above the hour or the smallest unit
 346            ;; above the hour is too large for the number of minutes we
 347            ;; need to represent.  Use H:MM or H:MM:SS syntax.
 348            (org-duration-from-minutes minutes mode canonical)
 349          ;; Represent minutes above hour using provided units and H:MM
 350          ;; or H:MM:SS below.
 351          (let* ((units-part (* min-modifier (floor (/ minutes min-modifier))))
 352                 (minutes-part (- minutes units-part)))
 353            (concat
 354             (org-duration-from-minutes units-part truncated-format canonical)
 355             " "
 356             (org-duration-from-minutes minutes-part mode))))))
 357     ;; Units format.
 358     (duration-format
 359      (let* ((fractional
 360              (let ((digits (cdr (assq 'special duration-format))))
 361                (and digits
 362                     (or (wholenump digits)
 363                         (error "Unknown formatting directive: %S" digits))
 364                     (format "%%.%df" digits))))
 365             (selected-units
 366              (sort (cl-remove-if
 367                     ;; Ignore special format cells.
 368                     (lambda (pair) (pcase pair (`(special . ,_) t) (_ nil)))
 369                     duration-format)
 370                    (lambda (a b)
 371                      (> (org-duration--modifier (car a) canonical)
 372                         (org-duration--modifier (car b) canonical))))))
 373        (cond
 374         ;; Fractional duration: use first unit that is either required
 375         ;; or smaller than MINUTES.
 376         (fractional
 377          (let* ((unit (car
 378                        (or (cl-find-if
 379                             (lambda (pair)
 380                               (pcase pair
 381                                 (`(,u . ,req?)
 382                                  (or req?
 383                                      (<= (org-duration--modifier u canonical)
 384                                          minutes)))))
 385                             selected-units)
 386                            ;; Fall back to smallest unit.
 387                            (org-last selected-units))))
 388                 (modifier (org-duration--modifier unit canonical)))
 389            (concat (format fractional (/ (float minutes) modifier)) unit)))
 390         ;; Otherwise build duration string according to available
 391         ;; units.
 392         ((org-string-nw-p
 393           (org-trim
 394            (mapconcat
 395             (lambda (units)
 396               (pcase-let* ((`(,unit . ,required?) units)
 397                            (modifier (org-duration--modifier unit canonical)))
 398                 (cond ((<= modifier minutes)
 399                        (let ((value (floor (/ minutes modifier))))
 400                          (cl-decf minutes (* value modifier))
 401                          (format " %d%s" value unit)))
 402                       (required? (concat " 0" unit))
 403                       (t ""))))
 404             selected-units
 405             ""))))
 406         ;; No unit can properly represent MINUTES.  Use the smallest
 407         ;; one anyway.
 408         (t
 409          (pcase-let ((`((,unit . ,_)) (last selected-units)))
 410            (concat
 411             (if (not fractional) "0"
 412               (let ((modifier (org-duration--modifier unit canonical)))
 413                 (format fractional (/ (float minutes) modifier))))
 414             unit))))))))
 415
 416 ;;;###autoload
 417 (defun org-duration-h:mm-only-p (times)
 418   "Non-nil when every duration in TIMES has \"H:MM\" or \"H:MM:SS\" format.
 419
 420 TIMES is a list of duration strings.
 421
 422 Return nil if any duration is expressed with units, as defined in
 423 `org-duration-units'.  Otherwise, if any duration is expressed
 424 with \"H:MM:SS\" format, return `h:mm:ss'.  Otherwise, return
 425 `h:mm'."
 426   (let (hms-flag)
 427     (catch :exit
 428       (dolist (time times)
 429         (cond ((string-match-p org-duration--full-re time)
 430                (throw :exit nil))
 431               ((string-match-p org-duration--mixed-re time)
 432                (throw :exit nil))
 433               (hms-flag nil)
 434               ((string-match-p org-duration--h:mm:ss-re time)
 435                (setq hms-flag 'h:mm:ss))))
 436       (or hms-flag 'h:mm))))
 437
 438 \f
 439 ;;; Initialization
 440
 441 (org-duration-set-regexps)
 442
 443 (provide 'org-duration)
 444 ;;; org-duration.el ends here