org-duration.el 15 KB

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