mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-21 7074318d7ab58aca124f590c42fd820e8eb258a5
commit | author | age
76bbd0 1 ;;; org-duration.el --- Library handling durations   -*- lexical-binding: t; -*-
C 2
3 ;; Copyright (C) 2017-2018 Free Software Foundation, Inc.
4
5 ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
6 ;; Keywords: outlines, hypermedia, calendar, wp
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 ;;   - 3d 13:35
32 ;;   - 2.35h
33 ;;
34 ;; More accurately, it consists of numbers and units, as defined in
35 ;; variable `org-duration-units', separated with white spaces, and
36 ;; a "H:MM" or "H:MM:SS" part.  White spaces are tolerated between the
37 ;; number and its relative unit.  Variable `org-duration-format'
38 ;; controls durations default representation.
39 ;;
40 ;; The library provides functions allowing to convert a duration to,
41 ;; and from, a number of minutes: `org-duration-to-minutes' and
42 ;; `org-duration-from-minutes'.  It also provides two lesser tools:
43 ;; `org-duration-p', and `org-duration-h:mm-only-p'.
44 ;;
45 ;; Users can set the number of minutes per unit, or define new units,
46 ;; in `org-duration-units'.  The library also supports canonical
47 ;; duration, i.e., a duration that doesn't depend on user's settings,
48 ;; through optional arguments.
49
50 ;;; Code:
51
52 (require 'cl-lib)
53 (require 'org-macs)
54 (declare-function org-trim "org" (s &optional keep-lead))
55
56
57 ;;; Public variables
58
59 (defconst org-duration-canonical-units
60   `(("min" . 1)
61     ("h" . 60)
62     ("d" . ,(* 60 24)))
63   "Canonical time duration units.
64 See `org-duration-units' for details.")
65
66 (defcustom org-duration-units
67   `(("min" . 1)
68     ("h" . 60)
69     ("d" . ,(* 60 24))
70     ("w" . ,(* 60 24 7))
71     ("m" . ,(* 60 24 30))
72     ("y" . ,(* 60 24 365.25)))
73   "Conversion factor to minutes for a duration.
74
75 Each entry has the form (UNIT . MODIFIER).
76
77 In a duration string, a number followed by UNIT is multiplied by
78 the specified number of MODIFIER to obtain a duration in minutes.
79
80 For example, the following value
81
82   \\=`((\"min\" . 1)
83     (\"h\" . 60)
84     (\"d\" . ,(* 60 8))
85     (\"w\" . ,(* 60 8 5))
86     (\"m\" . ,(* 60 8 5 4))
87     (\"y\" . ,(* 60 8 5 4 10)))
88
89 is meaningful if you work an average of 8 hours per day, 5 days
90 a week, 4 weeks a month and 10 months a year.
91
92 When setting this variable outside the Customize interface, make
93 sure to call the following command:
94
95   \\[org-duration-set-regexps]"
96   :group 'org-agenda
97   :version "26.1"
98   :package-version '(Org . "9.1")
99   :set (lambda (var val) (set-default var val) (org-duration-set-regexps))
100   :initialize 'custom-initialize-changed
101   :type '(choice
102       (const :tag "H:MM" h:mm)
103       (const :tag "H:MM:SS" h:mm:ss)
104       (alist :key-type (string :tag "Unit")
105          :value-type (number :tag "Modifier"))))
106
107 (defcustom org-duration-format '(("d" . nil) (special . h:mm))
108   "Format definition for a duration.
109
110 The value can be set to, respectively, the symbols `h:mm:ss' or
111 `h:mm', which means a duration is expressed as, respectively,
112 a \"H:MM:SS\" or \"H:MM\" string.
113
114 Alternatively, the value can be a list of entries following the
115 pattern:
116
117   (UNIT . REQUIRED?)
118
119 UNIT is a unit string, as defined in `org-duration-units'.  The
120 time duration is formatted using only the time components that
121 are specified here.
122
123 Units with a zero value are skipped, unless REQUIRED? is non-nil.
124 In that case, the unit is always used.
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
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
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 A bare number is translated into minutes.  The empty string is
278 translated into 0.0.
279
280 Return value as a float.  Raise an error if duration format is
281 not recognized."
282   (cond
283    ((equal duration "") 0.0)
284    ((numberp duration) (float duration))
285    ((string-match-p org-duration--h:mm-re duration)
286     (pcase-let ((`(,hours ,minutes ,seconds)
287          (mapcar #'string-to-number (split-string duration ":"))))
288       (+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
289    ((string-match-p org-duration--full-re duration)
290     (let ((minutes 0)
291       (s 0))
292       (while (string-match org-duration--unit-re duration s)
293     (setq s (match-end 0))
294     (let ((value (string-to-number (match-string 1 duration)))
295           (unit (match-string 2 duration)))
296       (cl-incf minutes (* value (org-duration--modifier unit canonical)))))
297       (float minutes)))
298    ((string-match org-duration--mixed-re duration)
299     (let ((units-part (match-string 1 duration))
300       (hms-part (match-string 2 duration)))
301       (+ (org-duration-to-minutes units-part)
302      (org-duration-to-minutes hms-part))))
303    ((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
304     (float (string-to-number duration)))
305    (t (error "Invalid duration format: %S" duration))))
306
307 ;;;###autoload
308 (defun org-duration-from-minutes (minutes &optional fmt canonical)
309   "Return duration string for a given number of MINUTES.
310
311 Format duration according to `org-duration-format' or FMT, when
312 non-nil.
313
314 When optional argument CANONICAL is non-nil, ignore
315 `org-duration-units' and use standard time units value.
316
317 Raise an error if expected format is unknown."
318   (pcase (or fmt org-duration-format)
319     (`h:mm
320      (let ((minutes (floor minutes)))
321        (format "%d:%02d" (/ minutes 60) (mod minutes 60))))
322     (`h:mm:ss
323      (let* ((whole-minutes (floor minutes))
324         (seconds (floor (* 60 (- minutes whole-minutes)))))
325        (format "%s:%02d"
326            (org-duration-from-minutes whole-minutes 'h:mm)
327            seconds)))
328     ((pred atom) (error "Invalid duration format specification: %S" fmt))
329     ;; Mixed format.  Call recursively the function on both parts.
330     ((and duration-format
331       (let `(special . ,(and mode (or `h:mm:ss `h:mm)))
332         (assq 'special duration-format)))
333      (let* ((truncated-format
334          ;; Remove "special" mode from duration format in order to
335          ;; recurse properly.  Also remove units smaller or equal
336          ;; to an hour since H:MM part takes care of it.
337          (cl-remove-if-not
338           (lambda (pair)
339         (pcase pair
340           (`(,(and unit (pred stringp)) . ,_)
341            (> (org-duration--modifier unit canonical) 60))
342           (_ nil)))
343           duration-format))
344         (min-modifier        ;smallest modifier above hour
345          (and truncated-format
346           (apply #'min
347              (mapcar (lambda (p)
348                    (org-duration--modifier (car p) canonical))
349                  truncated-format)))))
350        (if (or (null min-modifier) (< minutes min-modifier))
351        ;; There is not unit above the hour or the smallest unit
352        ;; above the hour is too large for the number of minutes we
353        ;; need to represent.  Use H:MM or H:MM:SS syntax.
354        (org-duration-from-minutes minutes mode canonical)
355      ;; Represent minutes above hour using provided units and H:MM
356      ;; or H:MM:SS below.
357      (let* ((units-part (* min-modifier (/ (floor minutes) min-modifier)))
358         (minutes-part (- minutes units-part)))
359        (concat
360         (org-duration-from-minutes units-part truncated-format canonical)
361         " "
362         (org-duration-from-minutes minutes-part mode))))))
363     ;; Units format.
364     (duration-format
365      (let* ((fractional
366          (let ((digits (cdr (assq 'special duration-format))))
367            (and digits
368             (or (wholenump digits)
369             (error "Unknown formatting directive: %S" digits))
370             (format "%%.%df" digits))))
371         (selected-units
372          (sort (cl-remove-if
373             ;; Ignore special format cells.
374             (lambda (pair) (pcase pair (`(special . ,_) t) (_ nil)))
375             duration-format)
376            (lambda (a b)
377              (> (org-duration--modifier (car a) canonical)
378             (org-duration--modifier (car b) canonical))))))
379        (cond
380     ;; Fractional duration: use first unit that is either required
381     ;; or smaller than MINUTES.
382     (fractional
383      (let* ((unit (car
384                (or (cl-find-if
385                 (lambda (pair)
386                   (pcase pair
387                 (`(,u . ,req?)
388                  (or req?
389                      (<= (org-duration--modifier u canonical)
390                      minutes)))))
391                 selected-units)
392                ;; Fall back to smallest unit.
393                (org-last selected-units))))
394         (modifier (org-duration--modifier unit canonical)))
395        (concat (format fractional (/ (float minutes) modifier)) unit)))
396     ;; Otherwise build duration string according to available
397     ;; units.
398     ((org-string-nw-p
399       (org-trim
400        (mapconcat
401         (lambda (units)
402           (pcase-let* ((`(,unit . ,required?) units)
403                (modifier (org-duration--modifier unit canonical)))
404         (cond ((<= modifier minutes)
405                (let ((value (if (integerp modifier)
406                     (/ (floor minutes) modifier)
407                       (floor (/ minutes modifier)))))
408              (cl-decf minutes (* value modifier))
409              (format " %d%s" value unit)))
410               (required? (concat " 0" unit))
411               (t ""))))
412         selected-units
413         ""))))
414     ;; No unit can properly represent MINUTES.  Use the smallest
415     ;; one anyway.
416     (t
417      (pcase-let ((`((,unit . ,_)) (last selected-units)))
418        (concat "0" unit))))))))
419
420 ;;;###autoload
421 (defun org-duration-h:mm-only-p (times)
422   "Non-nil when every duration in TIMES has \"H:MM\" or \"H:MM:SS\" format.
423
424 TIMES is a list of duration strings.
425
426 Return nil if any duration is expressed with units, as defined in
427 `org-duration-units'.  Otherwise, if any duration is expressed
428 with \"H:MM:SS\" format, return `h:mm:ss'.  Otherwise, return
429 `h:mm'."
430   (let (hms-flag)
431     (catch :exit
432       (dolist (time times)
433     (cond ((string-match-p org-duration--full-re time)
434            (throw :exit nil))
435           ((string-match-p org-duration--mixed-re time)
436            (throw :exit nil))
437           (hms-flag nil)
438           ((string-match-p org-duration--h:mm:ss-re time)
439            (setq hms-flag 'h:mm:ss))))
440       (or hms-flag 'h:mm))))
441
442
443 ;;; Initialization
444
445 (org-duration-set-regexps)
446
447 (provide 'org-duration)
448 ;;; org-duration.el ends here