org-timer.el (18299B)
1 ;;; org-timer.el --- Timer code for Org mode -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2008-2023 Free Software Foundation, Inc. 4 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, wp 7 ;; URL: https://orgmode.org 8 ;; 9 ;; This file is part of GNU Emacs. 10 ;; 11 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; 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 ;;; Commentary: 26 27 ;; This file implements two types of timers for Org buffers: 28 ;; 29 ;; - A relative timer that counts up (from 0 or a specified offset) 30 ;; - A countdown timer that counts down from a specified time 31 ;; 32 ;; The relative and countdown timers differ in their entry points. 33 ;; Use `org-timer' or `org-timer-start' to start the relative timer, 34 ;; and `org-timer-set-timer' to start the countdown timer. 35 36 ;;; Code: 37 38 (require 'org-macs) 39 (org-assert-version) 40 41 (require 'cl-lib) 42 (require 'org-clock) 43 44 (declare-function org-agenda-error "org-agenda" ()) 45 46 (defvar org-timer-start-time nil 47 "t=0 for the running timer.") 48 49 (defvar org-timer-pause-time nil 50 "Time when the timer was paused.") 51 52 (defvar org-timer-countdown-timer nil 53 "Current countdown timer. 54 This is a timer object if there is an active countdown timer, 55 `paused' if there is a paused countdown timer, and nil 56 otherwise.") 57 58 (defvar org-timer-countdown-timer-title nil 59 "Title for notification displayed when a countdown finishes.") 60 61 (defconst org-timer-re "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" 62 "Regular expression used to match timer stamps.") 63 64 (defcustom org-timer-format "%s " 65 "The format to insert the time of the timer. 66 This format must contain one instance of \"%s\" which will be replaced by 67 the value of the timer." 68 :group 'org-time 69 :type 'string) 70 71 (defcustom org-timer-default-timer "0" 72 "The default timer when a timer is set, in minutes or hh:mm:ss format. 73 When 0, the user is prompted for a value." 74 :group 'org-time 75 :version "26.1" 76 :package-version '(Org . "8.3") 77 :type 'string) 78 79 (defcustom org-timer-display 'mode-line 80 "Define where running timer is displayed, if at all. 81 When a timer is running, Org can display it in the mode line 82 and/or frame title. Allowed values are: 83 84 both displays in both mode line and frame title 85 mode-line displays only in mode line (default) 86 frame-title displays only in frame title 87 nil current timer is not displayed" 88 :group 'org-time 89 :type '(choice 90 (const :tag "Mode line" mode-line) 91 (const :tag "Frame title" frame-title) 92 (const :tag "Both" both) 93 (const :tag "None" nil))) 94 95 (defvar org-timer-start-hook nil 96 "Hook run after relative timer is started.") 97 98 (defvar org-timer-stop-hook nil 99 "Hook run before relative or countdown timer is stopped.") 100 101 (defvar org-timer-pause-hook nil 102 "Hook run before relative or countdown timer is paused.") 103 104 (defvar org-timer-continue-hook nil 105 "Hook run after relative or countdown timer is continued.") 106 107 (defvar org-timer-set-hook nil 108 "Hook run after countdown timer is set.") 109 110 (defvar org-timer-done-hook nil 111 "Hook run after countdown timer reaches zero.") 112 113 ;;;###autoload 114 (defun org-timer-start (&optional offset) 115 "Set the starting time for the relative timer to now. 116 When called with prefix argument OFFSET, prompt the user for an offset time, 117 with the default taken from a timer stamp at point, if any. 118 If OFFSET is a string or an integer, it is directly taken to be the offset 119 without user interaction. 120 When called with a double prefix arg, all timer strings in the active 121 region will be shifted by a specific amount. You will be prompted for 122 the amount, with the default to make the first timer string in 123 the region 0:00:00." 124 (interactive "P") 125 (cond 126 ((equal offset '(16)) 127 (call-interactively 'org-timer-change-times-in-region)) 128 (org-timer-countdown-timer 129 (user-error "Countdown timer is running. Cancel first")) 130 (t 131 (let (delta def s) 132 (if (not offset) 133 (setq org-timer-start-time (current-time)) 134 (cond 135 ((integerp offset) (setq delta offset)) 136 ((stringp offset) (setq delta (org-timer-hms-to-secs offset))) 137 (t 138 (setq def (if (org-in-regexp org-timer-re) 139 (match-string 0) 140 "0:00:00") 141 s (read-string 142 (format "Restart timer with offset [%s]: " def))) 143 (unless (string-match "\\S-" s) (setq s def)) 144 (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) 145 (setq org-timer-start-time (time-since delta))) 146 (setq org-timer-pause-time nil) 147 (org-timer-set-mode-line 'on) 148 (message "Timer start time set to %s, current value is %s" 149 (format-time-string "%T" org-timer-start-time) 150 (org-timer-secs-to-hms (or delta 0))) 151 (run-hooks 'org-timer-start-hook))))) 152 153 ;;;###autoload 154 (defun org-timer-pause-or-continue (&optional stop) 155 "Pause or continue the relative or countdown timer. 156 With prefix arg STOP, stop it entirely." 157 (interactive "P") 158 (cond 159 (stop (org-timer-stop)) 160 ((not org-timer-start-time) (error "No timer is running")) 161 (org-timer-pause-time 162 (let ((start-secs (float-time org-timer-start-time)) 163 (pause-secs (float-time org-timer-pause-time))) 164 (if org-timer-countdown-timer 165 (let ((new-secs (- start-secs pause-secs))) 166 (setq org-timer-countdown-timer 167 (org-timer--run-countdown-timer 168 new-secs org-timer-countdown-timer-title)) 169 (setq org-timer-start-time (time-add nil new-secs))) 170 (setq org-timer-start-time 171 (time-since (- pause-secs start-secs)))) 172 (setq org-timer-pause-time nil) 173 (org-timer-set-mode-line 'on) 174 (run-hooks 'org-timer-continue-hook) 175 (message "Timer continues at %s" (org-timer-value-string)))) 176 (t 177 ;; pause timer 178 (when org-timer-countdown-timer 179 (cancel-timer org-timer-countdown-timer) 180 (setq org-timer-countdown-timer 'paused)) 181 (run-hooks 'org-timer-pause-hook) 182 (setq org-timer-pause-time (current-time)) 183 (org-timer-set-mode-line 'paused) 184 (message "Timer paused at %s" (org-timer-value-string))))) 185 186 ;;;###autoload 187 (defun org-timer-stop () 188 "Stop the relative or countdown timer." 189 (interactive) 190 (unless org-timer-start-time 191 (user-error "No timer running")) 192 (when (timerp org-timer-countdown-timer) 193 (cancel-timer org-timer-countdown-timer)) 194 (run-hooks 'org-timer-stop-hook) 195 (setq org-timer-start-time nil 196 org-timer-pause-time nil 197 org-timer-countdown-timer nil) 198 (org-timer-set-mode-line 'off) 199 (message "Timer stopped")) 200 201 ;;;###autoload 202 (defun org-timer (&optional restart no-insert) 203 "Insert a H:MM:SS string from the timer into the buffer. 204 The first time this command is used, the timer is started. 205 206 When used with a `\\[universal-argument]' prefix, force restarting the timer. 207 208 When used with a `\\[universal-argument] \\[universal-argument]' \ 209 prefix, change all the timer strings 210 in the region by a fixed amount. This can be used to re-calibrate 211 a timer that was not started at the correct moment. 212 213 If NO-INSERT is non-nil, return the string instead of inserting 214 it in the buffer." 215 (interactive "P") 216 (if (equal restart '(16)) 217 (org-timer-start restart) 218 (when (or (equal restart '(4)) (not org-timer-start-time)) 219 (org-timer-start)) 220 (if no-insert 221 (org-timer-value-string) 222 (insert (org-timer-value-string))))) 223 224 (defun org-timer-value-string () 225 "Return current timer string." 226 (format org-timer-format 227 (org-timer-secs-to-hms 228 (let ((time (- (float-time org-timer-pause-time) 229 (float-time org-timer-start-time)))) 230 (abs (floor (if org-timer-countdown-timer (- time) time))))))) 231 232 ;;;###autoload 233 (defun org-timer-change-times-in-region (beg end delta) 234 "Change all h:mm:ss time in region by a DELTA." 235 (interactive 236 "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ") 237 (let ((re "[-+]?[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}") p) 238 (unless (string-match "\\S-" delta) 239 (save-excursion 240 (goto-char beg) 241 (when (re-search-forward re end t) 242 (setq delta (match-string 0)) 243 (if (equal (string-to-char delta) ?-) 244 (setq delta (substring delta 1)) 245 (setq delta (concat "-" delta)))))) 246 (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete delta))) 247 (when (= delta 0) (error "No change")) 248 (save-excursion 249 (goto-char end) 250 (while (re-search-backward re beg t) 251 (setq p (point)) 252 (replace-match 253 (save-match-data 254 (org-timer-secs-to-hms (+ (org-timer-hms-to-secs (match-string 0)) delta))) 255 t t) 256 (goto-char p))))) 257 258 ;;;###autoload 259 (defun org-timer-item (&optional arg) 260 "Insert a description-type item with the current timer value." 261 (interactive "P") 262 (let ((itemp (org-in-item-p)) (pos (point))) 263 (cond 264 ;; In a timer list, insert with `org-list-insert-item', 265 ;; then fix the list. 266 ((and itemp (goto-char itemp) (org-at-item-timer-p)) 267 (let* ((struct (org-list-struct)) 268 (prevs (org-list-prevs-alist struct)) 269 (s (concat (org-timer (when arg '(4)) t) ":: "))) 270 (setq struct (org-list-insert-item pos struct prevs nil s)) 271 (org-list-write-struct struct (org-list-parents-alist struct)) 272 (looking-at org-list-full-item-re) 273 (goto-char (match-end 0)))) 274 ;; In a list of another type, don't break anything: throw an error. 275 (itemp (goto-char pos) (error "This is not a timer list")) 276 ;; Else, start a new list. 277 (t 278 (beginning-of-line) 279 (org-indent-line) 280 (insert "- ") 281 (org-timer (when arg '(4))) 282 (insert ":: "))))) 283 284 (defun org-timer-fix-incomplete (hms) 285 "If hms is a H:MM:SS string with missing hour or hour and minute, fix it." 286 (if (string-match "\\(?:\\([0-9]+:\\)?\\([0-9]+:\\)\\)?\\([0-9]+\\)" hms) 287 (replace-match 288 (format "%d:%02d:%02d" 289 (if (match-end 1) (string-to-number (match-string 1 hms)) 0) 290 (if (match-end 2) (string-to-number (match-string 2 hms)) 0) 291 (string-to-number (match-string 3 hms))) 292 t t hms) 293 (error "Cannot parse HMS string \"%s\"" hms))) 294 295 (defun org-timer-hms-to-secs (hms) 296 "Convert h:mm:ss string to an integer time. 297 If the string starts with a minus sign, the integer will be negative." 298 (if (not (string-match 299 "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" 300 hms)) 301 0 302 (let* ((h (string-to-number (match-string 1 hms))) 303 (m (string-to-number (match-string 2 hms))) 304 (s (string-to-number (match-string 3 hms))) 305 (sign (equal (substring (match-string 1 hms) 0 1) "-"))) 306 (setq h (abs h)) 307 (* (if sign -1 1) (+ s (* 60 (+ m (* 60 h)))))))) 308 309 (defun org-timer-secs-to-hms (s) 310 "Convert integer S into h:mm:ss. 311 If the integer is negative, the string will start with \"-\"." 312 (let (sign m h) 313 (setq sign (if (< s 0) "-" "") 314 s (abs s) 315 m (/ s 60) s (- s (* 60 m)) 316 h (/ m 60) m (- m (* 60 h))) 317 (format "%s%d:%02d:%02d" sign h m s))) 318 319 (defvar org-timer-mode-line-timer nil) 320 (defvar org-timer-mode-line-string nil) 321 322 (defun org-timer-set-mode-line (value) 323 "Set the mode-line display for relative or countdown timer. 324 VALUE can be `on', `off', or `paused'." 325 (when (or (eq org-timer-display 'mode-line) 326 (eq org-timer-display 'both)) 327 (or global-mode-string (setq global-mode-string '(""))) 328 (or (memq 'org-timer-mode-line-string global-mode-string) 329 (setq global-mode-string 330 (append global-mode-string '(org-timer-mode-line-string))))) 331 (when (or (eq org-timer-display 'frame-title) 332 (eq org-timer-display 'both)) 333 (or (memq 'org-timer-mode-line-string frame-title-format) 334 (setq frame-title-format 335 (append frame-title-format '(org-timer-mode-line-string))))) 336 (cl-case value 337 (off 338 (when org-timer-mode-line-timer 339 (cancel-timer org-timer-mode-line-timer) 340 (setq org-timer-mode-line-timer nil)) 341 (when (or (eq org-timer-display 'mode-line) 342 (eq org-timer-display 'both)) 343 (setq global-mode-string 344 (delq 'org-timer-mode-line-string global-mode-string))) 345 (when (or (eq org-timer-display 'frame-title) 346 (eq org-timer-display 'both)) 347 (setq frame-title-format 348 (delq 'org-timer-mode-line-string frame-title-format))) 349 (force-mode-line-update)) 350 (paused 351 (when org-timer-mode-line-timer 352 (cancel-timer org-timer-mode-line-timer) 353 (setq org-timer-mode-line-timer nil))) 354 (on 355 (when (or (eq org-timer-display 'mode-line) 356 (eq org-timer-display 'both)) 357 (or global-mode-string (setq global-mode-string '(""))) 358 (or (memq 'org-timer-mode-line-string global-mode-string) 359 (setq global-mode-string 360 (append global-mode-string '(org-timer-mode-line-string))))) 361 (when (or (eq org-timer-display 'frame-title) 362 (eq org-timer-display 'both)) 363 (or (memq 'org-timer-mode-line-string frame-title-format) 364 (setq frame-title-format 365 (append frame-title-format '(org-timer-mode-line-string))))) 366 (org-timer-update-mode-line) 367 (when org-timer-mode-line-timer 368 (cancel-timer org-timer-mode-line-timer) 369 (setq org-timer-mode-line-timer nil)) 370 (when org-timer-display 371 (setq org-timer-mode-line-timer 372 (run-with-timer 1 1 #'org-timer-update-mode-line)))))) 373 374 (defun org-timer-update-mode-line () 375 "Update the timer time in the mode line." 376 (if org-timer-pause-time 377 nil 378 (setq org-timer-mode-line-string 379 (concat " <" (substring (org-timer-value-string) 0 -1) ">")) 380 (force-mode-line-update))) 381 382 (defun org-timer-show-remaining-time () 383 "Display the remaining time before the timer ends." 384 (interactive) 385 (message 386 (if (not org-timer-countdown-timer) 387 "No timer set" 388 (format-seconds 389 "%m minute(s) %s seconds left before next time out" 390 ;; Note: Once our minimal require is Emacs 27, we can drop this 391 ;; org-time-convert-to-integer call. 392 (org-time-convert-to-integer 393 (time-subtract (timer--time org-timer-countdown-timer) nil)))))) 394 395 ;;;###autoload 396 (defun org-timer-set-timer (&optional opt) 397 "Prompt for a duration in minutes or hh:mm:ss and set a timer. 398 399 If `org-timer-default-timer' is not \"0\", suggest this value as 400 the default duration for the timer. If a timer is already set, 401 prompt the user if she wants to replace it. 402 403 Called with a numeric prefix argument, use this numeric value as 404 the duration of the timer in minutes. 405 406 Called with a \\[universal-argument] prefix arguments, use `org-timer-default-timer' 407 without prompting the user for a duration. 408 409 With two \\[universal-argument] prefix arguments, use `org-timer-default-timer' 410 without prompting the user for a duration and automatically 411 replace any running timer. 412 413 By default, the timer duration will be set to the number of 414 minutes in the Effort property, if any. You can ignore this by 415 using three \\[universal-argument] prefix arguments." 416 (interactive "P") 417 (when (and org-timer-start-time 418 (not org-timer-countdown-timer)) 419 (user-error "Relative timer is running. Stop first")) 420 (let* ((default-timer 421 ;; `org-timer-default-timer' used to be a number, don't choke: 422 (if (numberp org-timer-default-timer) 423 (number-to-string org-timer-default-timer) 424 org-timer-default-timer)) 425 (effort-minutes (let ((effort (org-entry-get nil org-effort-property))) 426 (when (org-string-nw-p effort) 427 (floor (org-duration-to-minutes effort))))) 428 (minutes (or (and (numberp opt) (number-to-string opt)) 429 (and (not (equal opt '(64))) 430 effort-minutes 431 (number-to-string effort-minutes)) 432 (and (consp opt) default-timer) 433 (and (stringp opt) opt) 434 (read-from-minibuffer 435 "How much time left? (minutes or h:mm:ss) " 436 (and (not (string-equal default-timer "0")) default-timer))))) 437 (when (string-match "\\`[0-9]+\\'" minutes) 438 (setq minutes (concat minutes ":00"))) 439 (if (not (string-match "[0-9]+" minutes)) 440 (org-timer-show-remaining-time) 441 (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes)))) 442 (if (and org-timer-countdown-timer 443 (not (or (equal opt '(16)) 444 (y-or-n-p "Replace current timer? ")))) 445 (message "No timer set") 446 (when (timerp org-timer-countdown-timer) 447 (cancel-timer org-timer-countdown-timer)) 448 (setq org-timer-countdown-timer-title 449 (org-timer--get-timer-title)) 450 (setq org-timer-countdown-timer 451 (org-timer--run-countdown-timer 452 secs org-timer-countdown-timer-title)) 453 (run-hooks 'org-timer-set-hook) 454 (setq org-timer-start-time (time-add nil secs)) 455 (setq org-timer-pause-time nil) 456 (org-timer-set-mode-line 'on)))))) 457 458 (defun org-timer--run-countdown-timer (secs title) 459 "Start countdown timer that will last SECS. 460 TITLE will be appended to the notification message displayed when 461 time is up." 462 (let ((msg (format "%s: time out" title)) 463 (sound org-clock-sound)) 464 (run-with-timer 465 secs nil (lambda () 466 (setq org-timer-countdown-timer nil 467 org-timer-start-time nil) 468 (org-notify msg sound) 469 (org-timer-set-mode-line 'off) 470 (run-hooks 'org-timer-done-hook))))) 471 472 (defun org-timer--get-timer-title () 473 "Construct timer title. 474 Try to use an Org header, otherwise use the buffer name." 475 (cond 476 ((derived-mode-p 'org-agenda-mode) 477 (let* ((marker (or (get-text-property (point) 'org-marker))) 478 (hdmarker (or (get-text-property (point) 'org-hd-marker) 479 marker))) 480 (when (and marker (marker-buffer marker)) 481 (with-current-buffer (marker-buffer marker) 482 (org-with-wide-buffer 483 (goto-char hdmarker) 484 (or (ignore-errors (org-get-heading)) 485 (buffer-name (buffer-base-buffer)))))))) 486 ((derived-mode-p 'org-mode) 487 (ignore-errors (org-get-heading))) 488 (t (buffer-name (buffer-base-buffer))))) 489 490 (provide 'org-timer) 491 492 ;; Local variables: 493 ;; generated-autoload-file: "org-loaddefs.el" 494 ;; End: 495 496 ;;; org-timer.el ends here