org-timer.el 17.8 KB
Newer Older
Rasmus's avatar
Rasmus committed
1
;;; org-timer.el --- Timer code for Org mode         -*- lexical-binding: t; -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
4 5 6

;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
Rasmus's avatar
Rasmus committed
7
;; Homepage: https://orgmode.org
8 9 10 11 12 13 14 15 16 17 18 19 20 21
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
23 24 25 26
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:

Rasmus's avatar
Rasmus committed
27 28 29 30 31 32 33 34
;; This file implements two types of timers for Org buffers:
;;
;; - A relative timer that counts up (from 0 or a specified offset)
;; - A countdown timer that counts down from a specified time
;;
;; The relative and countdown timers differ in their entry points.
;; Use `org-timer' or `org-timer-start' to start the relative timer,
;; and `org-timer-set-timer' to start the countdown timer.
35

36 37
;;; Code:

Rasmus's avatar
Rasmus committed
38 39
(require 'cl-lib)
(require 'org-clock)
40

41 42
(declare-function org-agenda-error "org-agenda" ())

43 44 45
(defvar org-timer-start-time nil
  "t=0 for the running timer.")

46 47 48
(defvar org-timer-pause-time nil
  "Time when the timer was paused.")

Rasmus's avatar
Rasmus committed
49 50 51 52 53 54 55 56 57
(defvar org-timer-countdown-timer nil
  "Current countdown timer.
This is a timer object if there is an active countdown timer,
`paused' if there is a paused countdown timer, and nil
otherwise.")

(defvar org-timer-countdown-timer-title nil
  "Title for notification displayed when a countdown finishes.")

58 59 60 61 62 63
(defconst org-timer-re "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)"
  "Regular expression used to match timer stamps.")

(defcustom org-timer-format "%s "
  "The format to insert the time of the timer.
This format must contain one instance of \"%s\" which will be replaced by
Rasmus's avatar
Rasmus committed
64
the value of the timer."
65 66 67
  :group 'org-time
  :type 'string)

Rasmus's avatar
Rasmus committed
68 69
(defcustom org-timer-default-timer "0"
  "The default timer when a timer is set, in minutes or hh:mm:ss format.
70 71
When 0, the user is prompted for a value."
  :group 'org-time
Rasmus's avatar
Rasmus committed
72 73 74
  :version "26.1"
  :package-version '(Org . "8.3")
  :type 'string)
75

76
(defcustom org-timer-display 'mode-line
Rasmus's avatar
Rasmus committed
77 78 79
  "Define where running timer is displayed, if at all.
When a timer is running, Org can display it in the mode line
and/or frame title.  Allowed values are:
80 81 82 83 84 85 86 87 88 89 90 91

both         displays in both mode line and frame title
mode-line    displays only in mode line (default)
frame-title  displays only in frame title
nil          current timer is not displayed"
  :group 'org-time
  :type '(choice
	  (const :tag "Mode line" mode-line)
	  (const :tag "Frame title" frame-title)
	  (const :tag "Both" both)
	  (const :tag "None" nil)))

92 93 94 95
(defvar org-timer-start-hook nil
  "Hook run after relative timer is started.")

(defvar org-timer-stop-hook nil
Rasmus's avatar
Rasmus committed
96
  "Hook run before relative or countdown timer is stopped.")
97 98

(defvar org-timer-pause-hook nil
Rasmus's avatar
Rasmus committed
99
  "Hook run before relative or countdown timer is paused.")
100

101
(defvar org-timer-continue-hook nil
Rasmus's avatar
Rasmus committed
102
  "Hook run after relative or countdown timer is continued.")
103

104 105 106 107 108 109
(defvar org-timer-set-hook nil
  "Hook run after countdown timer is set.")

(defvar org-timer-done-hook nil
  "Hook run after countdown timer reaches zero.")

110 111 112 113 114 115 116 117 118 119 120 121
;;;###autoload
(defun org-timer-start (&optional offset)
  "Set the starting time for the relative timer to now.
When called with prefix argument OFFSET, prompt the user for an offset time,
with the default taken from a timer stamp at point, if any.
If OFFSET is a string or an integer, it is directly taken to be the offset
without user interaction.
When called with a double prefix arg, all timer strings in the active
region will be shifted by a specific amount.  You will be prompted for
the amount, with the default to make the first timer string in
the region 0:00:00."
  (interactive "P")
Rasmus's avatar
Rasmus committed
122 123 124 125 126 127
  (cond
   ((equal offset '(16))
    (call-interactively 'org-timer-change-times-in-region))
   (org-timer-countdown-timer
    (user-error "Countdown timer is running.  Cancel first"))
   (t
128 129 130 131 132 133 134 135 136 137 138 139 140 141
    (let (delta def s)
      (if (not offset)
	  (setq org-timer-start-time (current-time))
	(cond
	 ((integerp offset) (setq delta offset))
	 ((stringp offset) (setq delta (org-timer-hms-to-secs offset)))
	 (t
	  (setq def (if (org-in-regexp org-timer-re)
			(match-string 0)
		      "0:00:00")
		s (read-string
		   (format "Restart timer with offset [%s]: " def)))
	  (unless (string-match "\\S-" s) (setq s def))
	  (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s)))))
Bastien's avatar
Bastien committed
142
	(setq org-timer-start-time (org-time-since delta)))
Rasmus's avatar
Rasmus committed
143
      (setq org-timer-pause-time nil)
144
      (org-timer-set-mode-line 'on)
145 146
      (message "Timer start time set to %s, current value is %s"
	       (format-time-string "%T" org-timer-start-time)
147
	       (org-timer-secs-to-hms (or delta 0)))
Rasmus's avatar
Rasmus committed
148
      (run-hooks 'org-timer-start-hook)))))
149

Bastien's avatar
Bastien committed
150
;;;###autoload
151
(defun org-timer-pause-or-continue (&optional stop)
Rasmus's avatar
Rasmus committed
152
  "Pause or continue the relative or countdown timer.
153
With prefix arg STOP, stop it entirely."
154 155 156 157 158
  (interactive "P")
  (cond
   (stop (org-timer-stop))
   ((not org-timer-start-time) (error "No timer is running"))
   (org-timer-pause-time
Rasmus's avatar
Rasmus committed
159 160 161 162 163 164 165
    (let ((start-secs (float-time org-timer-start-time))
	  (pause-secs (float-time org-timer-pause-time)))
      (if org-timer-countdown-timer
	  (let ((new-secs (- start-secs pause-secs)))
	    (setq org-timer-countdown-timer
		  (org-timer--run-countdown-timer
		   new-secs org-timer-countdown-timer-title))
Bastien's avatar
Bastien committed
166
	    (setq org-timer-start-time (org-time-add nil new-secs)))
Rasmus's avatar
Rasmus committed
167
	(setq org-timer-start-time
Bastien's avatar
Bastien committed
168
	      (org-time-since (- pause-secs start-secs))))
Rasmus's avatar
Rasmus committed
169 170 171 172
      (setq org-timer-pause-time nil)
      (org-timer-set-mode-line 'on)
      (run-hooks 'org-timer-continue-hook)
      (message "Timer continues at %s" (org-timer-value-string))))
173 174
   (t
    ;; pause timer
Rasmus's avatar
Rasmus committed
175 176 177
    (when org-timer-countdown-timer
      (cancel-timer org-timer-countdown-timer)
      (setq org-timer-countdown-timer 'paused))
178
    (run-hooks 'org-timer-pause-hook)
179
    (setq org-timer-pause-time (current-time))
Rasmus's avatar
Rasmus committed
180
    (org-timer-set-mode-line 'paused)
181 182
    (message "Timer paused at %s" (org-timer-value-string)))))

Bastien's avatar
Bastien committed
183
;;;###autoload
184
(defun org-timer-stop ()
Rasmus's avatar
Rasmus committed
185
  "Stop the relative or countdown timer."
186
  (interactive)
Rasmus's avatar
Rasmus committed
187 188 189 190
  (unless org-timer-start-time
    (user-error "No timer running"))
  (when (timerp org-timer-countdown-timer)
    (cancel-timer org-timer-countdown-timer))
191
  (run-hooks 'org-timer-stop-hook)
192
  (setq org-timer-start-time nil
Bastien Guerry's avatar
Bastien Guerry committed
193
	org-timer-pause-time nil
Rasmus's avatar
Rasmus committed
194
	org-timer-countdown-timer nil)
195 196
  (org-timer-set-mode-line 'off)
  (message "Timer stopped"))
197

198
;;;###autoload
Rasmus's avatar
Rasmus committed
199
(defun org-timer (&optional restart no-insert)
200
  "Insert a H:MM:SS string from the timer into the buffer.
Rasmus's avatar
Rasmus committed
201 202 203 204 205 206 207 208
The first time this command is used, the timer is started.

When used with a `\\[universal-argument]' prefix, force restarting the timer.

When used with a `\\[universal-argument] \\[universal-argument]' \
prefix, change all the timer strings
in the region by a fixed amount.  This can be used to re-calibrate
a timer that was not started at the correct moment.
Carsten Dominik's avatar
Carsten Dominik committed
209

Rasmus's avatar
Rasmus committed
210
If NO-INSERT is non-nil, return the string instead of inserting
Carsten Dominik's avatar
Carsten Dominik committed
211
it in the buffer."
212
  (interactive "P")
Rasmus's avatar
Rasmus committed
213 214 215 216 217 218 219
  (if (equal restart '(16))
      (org-timer-start restart)
    (when (or (equal restart '(4)) (not org-timer-start-time))
      (org-timer-start))
    (if no-insert
	(org-timer-value-string)
      (insert (org-timer-value-string)))))
220 221

(defun org-timer-value-string ()
Bastien's avatar
Bastien committed
222
  "Return current timer string."
Bastien Guerry's avatar
Bastien Guerry committed
223 224
  (format org-timer-format
	  (org-timer-secs-to-hms
Bastien's avatar
Bastien committed
225 226 227
	   (let ((time (- (float-time org-timer-pause-time)
			  (float-time org-timer-start-time))))
	     (abs (floor (if org-timer-countdown-timer (- time) time)))))))
228 229 230 231 232

;;;###autoload
(defun org-timer-change-times-in-region (beg end delta)
  "Change all h:mm:ss time in region by a DELTA."
  (interactive
233
   "r\nsEnter time difference like \"-1:08:26\".  Default is first time to zero: ")
234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256
  (let ((re "[-+]?[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}") p)
    (unless (string-match "\\S-" delta)
      (save-excursion
	(goto-char beg)
	(when (re-search-forward re end t)
	  (setq delta (match-string 0))
	  (if (equal (string-to-char delta) ?-)
	      (setq delta (substring delta 1))
	    (setq delta (concat "-" delta))))))
    (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete delta)))
    (when (= delta 0) (error "No change"))
    (save-excursion
      (goto-char end)
      (while (re-search-backward re beg t)
	(setq p (point))
	(replace-match
	 (save-match-data
	   (org-timer-secs-to-hms (+ (org-timer-hms-to-secs (match-string 0)) delta)))
	 t t)
	(goto-char p)))))

;;;###autoload
(defun org-timer-item (&optional arg)
257
  "Insert a description-type item with the current timer value."
258
  (interactive "P")
259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275
  (let ((itemp (org-in-item-p)) (pos (point)))
    (cond
     ;; In a timer list, insert with `org-list-insert-item',
     ;; then fix the list.
     ((and itemp (goto-char itemp) (org-at-item-timer-p))
      (let* ((struct (org-list-struct))
	     (prevs (org-list-prevs-alist struct))
	     (s (concat (org-timer (when arg '(4)) t) ":: ")))
	(setq struct (org-list-insert-item pos struct prevs nil s))
	(org-list-write-struct struct (org-list-parents-alist struct))
	(looking-at org-list-full-item-re)
	(goto-char (match-end 0))))
     ;; In a list of another type, don't break anything: throw an error.
     (itemp (goto-char pos) (error "This is not a timer list"))
     ;; Else, start a new list.
     (t
      (beginning-of-line)
276
      (org-indent-line)
277 278 279
      (insert  "- ")
      (org-timer (when arg '(4)))
      (insert ":: ")))))
280 281 282 283 284 285 286 287 288 289

(defun org-timer-fix-incomplete (hms)
  "If hms is a H:MM:SS string with missing hour or hour and minute, fix it."
  (if (string-match "\\(?:\\([0-9]+:\\)?\\([0-9]+:\\)\\)?\\([0-9]+\\)" hms)
      (replace-match
       (format "%d:%02d:%02d"
	       (if (match-end 1) (string-to-number (match-string 1 hms)) 0)
	       (if (match-end 2) (string-to-number (match-string 2 hms)) 0)
	       (string-to-number (match-string 3 hms)))
       t t hms)
290
    (error "Cannot parse HMS string \"%s\"" hms)))
291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307

(defun org-timer-hms-to-secs (hms)
  "Convert h:mm:ss string to an integer time.
If the string starts with a minus sign, the integer will be negative."
  (if (not (string-match
	    "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)"
	    hms))
      0
    (let* ((h (string-to-number (match-string 1 hms)))
	   (m (string-to-number (match-string 2 hms)))
	   (s (string-to-number (match-string 3 hms)))
	   (sign (equal (substring (match-string 1 hms) 0 1) "-")))
      (setq h (abs h))
      (* (if sign -1 1) (+ s (* 60 (+ m (* 60 h))))))))

(defun org-timer-secs-to-hms (s)
  "Convert integer S into h:mm:ss.
308
If the integer is negative, the string will start with \"-\"."
309 310 311 312 313 314 315
  (let (sign m h)
    (setq sign (if (< s 0) "-" "")
	  s (abs s)
	  m (/ s 60) s (- s (* 60 m))
	  h (/ m 60) m (- m (* 60 h)))
    (format "%s%d:%02d:%02d" sign h m s)))

316 317 318 319
(defvar org-timer-mode-line-timer nil)
(defvar org-timer-mode-line-string nil)

(defun org-timer-set-mode-line (value)
Rasmus's avatar
Rasmus committed
320 321
  "Set the mode-line display for relative or countdown timer.
VALUE can be `on', `off', or `paused'."
322 323 324 325 326 327 328 329 330 331 332
  (when (or (eq org-timer-display 'mode-line)
	    (eq org-timer-display 'both))
    (or global-mode-string (setq global-mode-string '("")))
    (or (memq 'org-timer-mode-line-string global-mode-string)
	(setq global-mode-string
	      (append global-mode-string '(org-timer-mode-line-string)))))
  (when (or (eq org-timer-display 'frame-title)
	    (eq org-timer-display 'both))
    (or (memq 'org-timer-mode-line-string frame-title-format)
	(setq frame-title-format
	      (append frame-title-format '(org-timer-mode-line-string)))))
Rasmus's avatar
Rasmus committed
333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369
  (cl-case value
    (off
     (when org-timer-mode-line-timer
       (cancel-timer org-timer-mode-line-timer)
       (setq org-timer-mode-line-timer nil))
     (when (or (eq org-timer-display 'mode-line)
	       (eq org-timer-display 'both))
       (setq global-mode-string
	     (delq 'org-timer-mode-line-string global-mode-string)))
     (when (or (eq org-timer-display 'frame-title)
	       (eq org-timer-display 'both))
       (setq frame-title-format
	     (delq 'org-timer-mode-line-string frame-title-format)))
     (force-mode-line-update))
    (paused
     (when org-timer-mode-line-timer
       (cancel-timer org-timer-mode-line-timer)
       (setq org-timer-mode-line-timer nil)))
    (on
     (when (or (eq org-timer-display 'mode-line)
	       (eq org-timer-display 'both))
       (or global-mode-string (setq global-mode-string '("")))
       (or (memq 'org-timer-mode-line-string global-mode-string)
	   (setq global-mode-string
		 (append global-mode-string '(org-timer-mode-line-string)))))
     (when (or (eq org-timer-display 'frame-title)
	       (eq org-timer-display 'both))
       (or (memq 'org-timer-mode-line-string frame-title-format)
	   (setq frame-title-format
		 (append frame-title-format '(org-timer-mode-line-string)))))
     (org-timer-update-mode-line)
     (when org-timer-mode-line-timer
       (cancel-timer org-timer-mode-line-timer)
       (setq org-timer-mode-line-timer nil))
     (when org-timer-display
       (setq org-timer-mode-line-timer
	     (run-with-timer 1 1 'org-timer-update-mode-line))))))
370 371 372 373 374 375 376 377 378

(defun org-timer-update-mode-line ()
  "Update the timer time in the mode line."
  (if org-timer-pause-time
      nil
    (setq org-timer-mode-line-string
	  (concat " <" (substring (org-timer-value-string) 0 -1) ">"))
    (force-mode-line-update)))

379 380 381
(defun org-timer-show-remaining-time ()
  "Display the remaining time before the timer ends."
  (interactive)
382 383 384 385 386
  (message
   (if (not org-timer-countdown-timer)
       "No timer set"
     (format-seconds
      "%m minute(s) %s seconds left before next time out"
Bastien's avatar
Bastien committed
387 388 389 390
      ;; Note: Once our minimal require is Emacs 27, we can drop this
      ;; org-time-convert-to-integer call.
      (org-time-convert-to-integer
       (org-time-subtract (timer--time org-timer-countdown-timer) nil))))))
391 392

;;;###autoload
393
(defun org-timer-set-timer (&optional opt)
Rasmus's avatar
Rasmus committed
394
  "Prompt for a duration in minutes or hh:mm:ss and set a timer.
395

Rasmus's avatar
Rasmus committed
396
If `org-timer-default-timer' is not \"0\", suggest this value as
397
the default duration for the timer.  If a timer is already set,
Carsten Dominik's avatar
Carsten Dominik committed
398
prompt the user if she wants to replace it.
399 400

Called with a numeric prefix argument, use this numeric value as
Rasmus's avatar
Rasmus committed
401
the duration of the timer in minutes.
402 403 404 405 406 407

Called with a `C-u' prefix arguments, use `org-timer-default-timer'
without prompting the user for a duration.

With two `C-u' prefix arguments, use `org-timer-default-timer'
without prompting the user for a duration and automatically
Rasmus's avatar
Rasmus committed
408 409 410 411 412
replace any running timer.

By default, the timer duration will be set to the number of
minutes in the Effort property, if any.  You can ignore this by
using three `C-u' prefix arguments."
413
  (interactive "P")
Rasmus's avatar
Rasmus committed
414 415 416 417 418 419 420 421
  (when (and org-timer-start-time
	     (not org-timer-countdown-timer))
    (user-error "Relative timer is running.  Stop first"))
  (let* ((default-timer
	   ;; `org-timer-default-timer' used to be a number, don't choke:
	   (if (numberp org-timer-default-timer)
	       (number-to-string org-timer-default-timer)
	     org-timer-default-timer))
Bastien's avatar
Bastien committed
422 423 424
	 (effort-minutes (let ((effort (org-entry-get nil org-effort-property)))
			   (when (org-string-nw-p effort)
			     (floor (org-duration-to-minutes effort)))))
Rasmus's avatar
Rasmus committed
425 426 427 428 429 430 431 432 433 434 435
	 (minutes (or (and (numberp opt) (number-to-string opt))
		      (and (not (equal opt '(64)))
			   effort-minutes
			   (number-to-string effort-minutes))
		      (and (consp opt) default-timer)
		      (and (stringp opt) opt)
		      (read-from-minibuffer
		       "How much time left? (minutes or h:mm:ss) "
		       (and (not (string-equal default-timer "0")) default-timer)))))
    (when (string-match "\\`[0-9]+\\'" minutes)
      (setq minutes (concat minutes ":00")))
436 437
    (if (not (string-match "[0-9]+" minutes))
	(org-timer-show-remaining-time)
Rasmus's avatar
Rasmus committed
438 439 440 441 442 443 444 445 446 447 448 449 450
      (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes))))
	(if (and org-timer-countdown-timer
		 (not (or (equal opt '(16))
			  (y-or-n-p "Replace current timer? "))))
	    (message "No timer set")
	  (when (timerp org-timer-countdown-timer)
	    (cancel-timer org-timer-countdown-timer))
	  (setq org-timer-countdown-timer-title
		(org-timer--get-timer-title))
	  (setq org-timer-countdown-timer
		(org-timer--run-countdown-timer
		 secs org-timer-countdown-timer-title))
	  (run-hooks 'org-timer-set-hook)
Bastien's avatar
Bastien committed
451
	  (setq org-timer-start-time (org-time-add nil secs))
Rasmus's avatar
Rasmus committed
452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468
	  (setq org-timer-pause-time nil)
	  (org-timer-set-mode-line 'on))))))

(defun org-timer--run-countdown-timer (secs title)
  "Start countdown timer that will last SECS.
TITLE will be appended to the notification message displayed when
time is up."
  (let ((msg (format "%s: time out" title)))
    (run-with-timer
     secs nil `(lambda ()
		 (setq org-timer-countdown-timer nil
		       org-timer-start-time nil)
		 (org-notify ,msg ,org-clock-sound)
		 (org-timer-set-mode-line 'off)
		 (run-hooks 'org-timer-done-hook)))))

(defun org-timer--get-timer-title ()
Bastien's avatar
Bastien committed
469 470
  "Construct timer title.
Try to use an Org header, otherwise use the buffer name."
Rasmus's avatar
Rasmus committed
471 472 473 474 475 476 477 478 479 480 481 482 483 484 485
  (cond
   ((derived-mode-p 'org-agenda-mode)
    (let* ((marker (or (get-text-property (point) 'org-marker)
		       (org-agenda-error)))
	   (hdmarker (or (get-text-property (point) 'org-hd-marker)
			 marker)))
      (with-current-buffer (marker-buffer marker)
	(org-with-wide-buffer
	 (goto-char hdmarker)
	 (org-show-entry)
	 (or (ignore-errors (org-get-heading))
	     (buffer-name (buffer-base-buffer)))))))
   ((derived-mode-p 'org-mode)
    (or (ignore-errors (org-get-heading))
	(buffer-name (buffer-base-buffer))))
Bastien's avatar
Bastien committed
486
   (t (buffer-name (buffer-base-buffer)))))
487

488 489
(provide 'org-timer)

490 491 492 493
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:

494
;;; org-timer.el ends here