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 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 As a special case, a bare number represents minutes.
 278
 279 Return value as a float.  Raise an error if duration format is
 280 not recognized."
 281   (cond
 282    ((numberp duration) (float duration))
 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 0))
 290       (while (string-match org-duration--unit-re duration s)
 291         (setq s (match-end 0))
 292         (let ((value (string-to-number (match-string 1 duration)))
 293               (unit (match-string 2 duration)))
 294           (cl-incf minutes (* value (org-duration--modifier unit canonical)))))
 295       (float minutes)))
 296    ((string-match org-duration--mixed-re duration)
 297     (let ((units-part (match-string 1 duration))
 298           (hms-part (match-string 2 duration)))
 299       (+ (org-duration-to-minutes units-part)
 300          (org-duration-to-minutes hms-part))))
 301    ((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
 302     (float (string-to-number duration)))
 303    (t (error "Invalid duration format: %S" duration))))
 304
 305 ;;;###autoload
 306 (defun org-duration-from-minutes (minutes &optional fmt canonical)
 307   "Return duration string for a given number of MINUTES.
 308
 309 Format duration according to `org-duration-format' or FMT, when
 310 non-nil.
 311
 312 When optional argument CANONICAL is non-nil, ignore
 313 `org-duration-units' and use standard time units value.
 314
 315 Raise an error if expected format is unknown."
 316   (pcase (or fmt org-duration-format)
 317     (`h:mm
 318      (let ((minutes (floor minutes)))
 319        (format "%d:%02d" (/ minutes 60) (mod minutes 60))))
 320     (`h:mm:ss
 321      (let ((seconds (floor (* 60 minutes)) ))
 322        (format "%s:%02d"
 323                (org-duration-from-minutes (/ seconds 60) 'h:mm)
 324                (mod seconds 60))))
 325     ((pred atom) (error "Invalid duration format specification: %S" fmt))
 326     ;; Mixed format.  Call recursively the function on both parts.
 327     ((and duration-format
 328           (let `(special . ,(and mode (or `h:mm:ss `h:mm)))
 329             (assq 'special duration-format)))
 330      (let* ((truncated-format
 331              ;; Remove "special" mode from duration format in order to
 332              ;; recurse properly.  Also remove units smaller or equal
 333              ;; to an hour since H:MM part takes care of it.
 334              (cl-remove-if-not
 335               (lambda (pair)
 336                 (pcase pair
 337                   (`(,(and unit (pred stringp)) . ,_)
 338                    (> (org-duration--modifier unit canonical) 60))
 339                   (_ nil)))
 340               duration-format))
 341             (min-modifier               ;smallest modifier above hour
 342              (and truncated-format
 343                   (apply #'min
 344                          (mapcar (lambda (p)
 345                                    (org-duration--modifier (car p) canonical))
 346                                  truncated-format)))))
 347        (if (or (null min-modifier) (< minutes min-modifier))
 348            ;; There is not unit above the hour or the smallest unit
 349            ;; above the hour is too large for the number of minutes we
 350            ;; need to represent.  Use H:MM or H:MM:SS syntax.
 351            (org-duration-from-minutes minutes mode canonical)
 352          ;; Represent minutes above hour using provided units and H:MM
 353          ;; or H:MM:SS below.
 354          (let* ((units-part (* min-modifier (floor (/ minutes min-modifier))))
 355                 (minutes-part (- minutes units-part)))
 356            (concat
 357             (org-duration-from-minutes units-part truncated-format canonical)
 358             " "
 359             (org-duration-from-minutes minutes-part mode))))))
 360     ;; Units format.
 361     (duration-format
 362      (let* ((fractional
 363              (let ((digits (cdr (assq 'special duration-format))))
 364                (and digits
 365                     (or (wholenump digits)
 366                         (error "Unknown formatting directive: %S" digits))
 367                     (format "%%.%df" digits))))
 368             (selected-units
 369              (sort (cl-remove-if
 370                     ;; Ignore special format cells.
 371                     (lambda (pair) (pcase pair (`(special . ,_) t) (_ nil)))
 372                     duration-format)
 373                    (lambda (a b)
 374                      (> (org-duration--modifier (car a) canonical)
 375                         (org-duration--modifier (car b) canonical))))))
 376        (cond
 377         ;; Fractional duration: use first unit that is either required
 378         ;; or smaller than MINUTES.
 379         (fractional
 380          (let* ((unit (car
 381                        (or (cl-find-if
 382                             (lambda (pair)
 383                               (pcase pair
 384                                 (`(,u . ,req?)
 385                                  (or req?
 386                                      (<= (org-duration--modifier u canonical)
 387                                          minutes)))))
 388                             selected-units)
 389                            ;; Fall back to smallest unit.
 390                            (org-last selected-units))))
 391                 (modifier (org-duration--modifier unit canonical)))
 392            (concat (format fractional (/ (float minutes) modifier)) unit)))
 393         ;; Otherwise build duration string according to available
 394         ;; units.
 395         ((org-string-nw-p
 396           (org-trim
 397            (mapconcat
 398             (lambda (units)
 399               (pcase-let* ((`(,unit . ,required?) units)
 400                            (modifier (org-duration--modifier unit canonical)))
 401                 (cond ((<= modifier minutes)
 402                        (let ((value (floor (/ minutes modifier))))
 403                          (cl-decf minutes (* value modifier))
 404                          (format " %d%s" value unit)))
 405                       (required? (concat " 0" unit))
 406                       (t ""))))
 407             selected-units
 408             ""))))
 409         ;; No unit can properly represent MINUTES.  Use the smallest
 410         ;; one anyway.
 411         (t
 412          (pcase-let ((`((,unit . ,_)) (last selected-units)))
 413            (concat
 414             (if (not fractional) "0"
 415               (let ((modifier (org-duration--modifier unit canonical)))
 416                 (format fractional (/ (float minutes) modifier))))
 417             unit))))))))
 418
 419 ;;;###autoload
 420 (defun org-duration-h:mm-only-p (times)
 421   "Non-nil when every duration in TIMES has \"H:MM\" or \"H:MM:SS\" format.
 422
 423 TIMES is a list of duration strings.
 424
 425 Return nil if any duration is expressed with units, as defined in
 426 `org-duration-units'.  Otherwise, if any duration is expressed
 427 with \"H:MM:SS\" format, return `h:mm:ss'.  Otherwise, return
 428 `h:mm'."
 429   (let (hms-flag)
 430     (catch :exit
 431       (dolist (time times)
 432         (cond ((string-match-p org-duration--full-re time)
 433                (throw :exit nil))
 434               ((string-match-p org-duration--mixed-re time)
 435                (throw :exit nil))
 436               (hms-flag nil)
 437               ((string-match-p org-duration--h:mm:ss-re time)
 438                (setq hms-flag 'h:mm:ss))))
 439       (or hms-flag 'h:mm))))
 440
 441 \f
 442 ;;; Initialization
 443
 444 (org-duration-set-regexps)
 445
 446 (provide 'org-duration)
 447 ;;; org-duration.el ends here