config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

org-duration.el (15758B)


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