org-timer.el (18585B)
1 ;;; org-timer.el --- Timer code for Org mode -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2008-2024 Free Software Foundation, Inc. 4 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, text 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 "Start time 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 RESTART, force 207 restarting the timer. 208 209 When used with a `\\[universal-argument] \\[universal-argument]' prefix 210 RESTART, change all the timer strings in the region by a fixed amount. 211 This can be used to re-calibrate a timer that was not started at the 212 correct moment. 213 214 If NO-INSERT is non-nil, return the string instead of inserting it in 215 the buffer." 216 (interactive "P") 217 (if (equal restart '(16)) 218 (org-timer-start restart) 219 (when (or (equal restart '(4)) (not org-timer-start-time)) 220 (org-timer-start)) 221 (if no-insert 222 (org-timer-value-string) 223 (insert (org-timer-value-string))))) 224 225 (defun org-timer-value-string () 226 "Return current timer string." 227 (format org-timer-format 228 (org-timer-secs-to-hms 229 (let ((time (- (float-time org-timer-pause-time) 230 (float-time org-timer-start-time)))) 231 (abs (floor (if org-timer-countdown-timer (- time) time))))))) 232 233 ;;;###autoload 234 (defun org-timer-change-times-in-region (beg end delta) 235 "Change all h:mm:ss time in region BEG..END by a DELTA." 236 (interactive 237 "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ") 238 (let ((re "[-+]?[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}") p) 239 (unless (string-match "\\S-" delta) 240 (save-excursion 241 (goto-char beg) 242 (when (re-search-forward re end t) 243 (setq delta (match-string 0)) 244 (if (equal (string-to-char delta) ?-) 245 (setq delta (substring delta 1)) 246 (setq delta (concat "-" delta)))))) 247 (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete delta))) 248 (when (= delta 0) (error "No change")) 249 (save-excursion 250 (goto-char end) 251 (while (re-search-backward re beg t) 252 (setq p (point)) 253 (replace-match 254 (save-match-data 255 (org-timer-secs-to-hms (+ (org-timer-hms-to-secs (match-string 0)) delta))) 256 t t) 257 (goto-char p))))) 258 259 ;;;###autoload 260 (defun org-timer-item (&optional arg) 261 "Insert a description-type item with the current timer value. 262 Prefix argument ARG is passed to `org-timer'." 263 (interactive "P") 264 (let ((itemp (org-in-item-p)) (pos (point))) 265 (cond 266 ;; In a timer list, insert with `org-list-insert-item', 267 ;; then fix the list. 268 ((and itemp (goto-char itemp) (org-at-item-timer-p)) 269 (let* ((struct (org-list-struct)) 270 (prevs (org-list-prevs-alist struct)) 271 (s (concat (org-timer (when arg '(4)) t) ":: "))) 272 (setq struct (org-list-insert-item pos struct prevs nil s)) 273 (org-list-write-struct struct (org-list-parents-alist struct)) 274 (looking-at org-list-full-item-re) 275 (goto-char (match-end 0)))) 276 ;; In a list of another type, don't break anything: throw an error. 277 (itemp (goto-char pos) (error "This is not a timer list")) 278 ;; Else, start a new list. 279 (t 280 (forward-line 0) 281 (org-indent-line) 282 (insert "- ") 283 (org-timer (when arg '(4))) 284 (insert ":: "))))) 285 286 (defun org-timer-fix-incomplete (hms) 287 "If HMS is a H:MM:SS string with missing hour or hour and minute, fix it." 288 (if (string-match "\\(?:\\([0-9]+:\\)?\\([0-9]+:\\)\\)?\\([0-9]+\\)" hms) 289 (replace-match 290 (format "%d:%02d:%02d" 291 (if (match-end 1) (string-to-number (match-string 1 hms)) 0) 292 (if (match-end 2) (string-to-number (match-string 2 hms)) 0) 293 (string-to-number (match-string 3 hms))) 294 t t hms) 295 (error "Cannot parse HMS string \"%s\"" hms))) 296 297 (defun org-timer-hms-to-secs (hms) 298 "Convert h:mm:ss (HMS) string to an integer time. 299 If the string starts with a minus sign, the integer will be negative." 300 (if (not (string-match 301 "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" 302 hms)) 303 0 304 (let* ((h (string-to-number (match-string 1 hms))) 305 (m (string-to-number (match-string 2 hms))) 306 (s (string-to-number (match-string 3 hms))) 307 (sign (equal (substring (match-string 1 hms) 0 1) "-"))) 308 (setq h (abs h)) 309 (* (if sign -1 1) (+ s (* 60 (+ m (* 60 h)))))))) 310 311 (defun org-timer-secs-to-hms (s) 312 "Convert integer S into h:mm:ss. 313 If the integer is negative, the string will start with \"-\"." 314 (let (sign m h) 315 (setq sign (if (< s 0) "-" "") 316 s (abs s) 317 m (/ s 60) s (- s (* 60 m)) 318 h (/ m 60) m (- m (* 60 h))) 319 (format "%s%d:%02d:%02d" sign h m s))) 320 321 (defvar org-timer-mode-line-timer nil) 322 (defvar org-timer-mode-line-string nil) 323 324 (defun org-timer-set-mode-line (value) 325 "Set the mode-line display for relative or countdown timer. 326 VALUE can be `on', `off', or `paused'." 327 (when (or (eq org-timer-display 'mode-line) 328 (eq org-timer-display 'both)) 329 (or global-mode-string (setq global-mode-string '(""))) 330 (or (memq 'org-timer-mode-line-string global-mode-string) 331 (setq global-mode-string 332 (append global-mode-string '(org-timer-mode-line-string))))) 333 (when (or (eq org-timer-display 'frame-title) 334 (eq org-timer-display 'both)) 335 (or (memq 'org-timer-mode-line-string frame-title-format) 336 (setq frame-title-format 337 (append frame-title-format '(org-timer-mode-line-string))))) 338 (cl-case value 339 (off 340 (when org-timer-mode-line-timer 341 (cancel-timer org-timer-mode-line-timer) 342 (setq org-timer-mode-line-timer nil)) 343 (when (or (eq org-timer-display 'mode-line) 344 (eq org-timer-display 'both)) 345 (setq global-mode-string 346 (delq 'org-timer-mode-line-string global-mode-string))) 347 (when (or (eq org-timer-display 'frame-title) 348 (eq org-timer-display 'both)) 349 (setq frame-title-format 350 (delq 'org-timer-mode-line-string frame-title-format))) 351 (force-mode-line-update)) 352 (paused 353 (when org-timer-mode-line-timer 354 (cancel-timer org-timer-mode-line-timer) 355 (setq org-timer-mode-line-timer nil))) 356 (on 357 (when (or (eq org-timer-display 'mode-line) 358 (eq org-timer-display 'both)) 359 (or global-mode-string (setq global-mode-string '(""))) 360 (or (memq 'org-timer-mode-line-string global-mode-string) 361 (setq global-mode-string 362 (append global-mode-string '(org-timer-mode-line-string))))) 363 (when (or (eq org-timer-display 'frame-title) 364 (eq org-timer-display 'both)) 365 (or (memq 'org-timer-mode-line-string frame-title-format) 366 (setq frame-title-format 367 (append frame-title-format '(org-timer-mode-line-string))))) 368 (org-timer-update-mode-line) 369 (when org-timer-mode-line-timer 370 (cancel-timer org-timer-mode-line-timer) 371 (setq org-timer-mode-line-timer nil)) 372 (when org-timer-display 373 (setq org-timer-mode-line-timer 374 (run-with-timer 1 1 #'org-timer-update-mode-line)))))) 375 376 (defun org-timer-update-mode-line () 377 "Update the timer time in the mode line." 378 (if org-timer-pause-time 379 nil 380 (setq org-timer-mode-line-string 381 (concat " <" (substring (org-timer-value-string) 0 -1) ">")) 382 (force-mode-line-update))) 383 384 (defun org-timer-show-remaining-time () 385 "Display the remaining time before the timer ends." 386 (interactive) 387 (message 388 (if (not org-timer-countdown-timer) 389 "No timer set" 390 (format-seconds 391 "%m minute(s) %s seconds left before next time out" 392 ;; Note: Once our minimal require is Emacs 27, we can drop this 393 ;; org-time-convert-to-integer call. 394 (org-time-convert-to-integer 395 (time-subtract (timer--time org-timer-countdown-timer) nil)))))) 396 397 ;;;###autoload 398 (defun org-timer-set-timer (&optional opt) 399 "Prompt for a duration in minutes or hh:mm:ss and set a timer. 400 401 If `org-timer-default-timer' is not \"0\", suggest this value as 402 the default duration for the timer. If a timer is already set, 403 prompt the user if she wants to replace it. 404 405 Called with a numeric prefix argument OPT, use this numeric value as 406 the duration of the timer in minutes. 407 408 Called with a \\[universal-argument] prefix argument OPT, use 409 `org-timer-default-timer' without prompting the user for a duration. 410 411 With two \\[universal-argument] prefix arguments OPT, use 412 `org-timer-default-timer' without prompting the user for a duration 413 and automatically replace any running timer. 414 415 By default, the timer duration will be set to the number of 416 minutes in the Effort property, if any. You can ignore this by 417 using three \\[universal-argument] prefix arguments." 418 (interactive "P") 419 (when (and org-timer-start-time 420 (not org-timer-countdown-timer)) 421 (user-error "Relative timer is running. Stop first")) 422 (let* ((default-timer 423 ;; `org-timer-default-timer' used to be a number, don't choke: 424 (if (numberp org-timer-default-timer) 425 (number-to-string org-timer-default-timer) 426 org-timer-default-timer)) 427 (effort-minutes 428 (cond ((derived-mode-p 'org-agenda-mode) 429 (org-get-at-bol 'effort-minutes)) 430 ((derived-mode-p 'org-mode) 431 (let ((effort (org-entry-get nil org-effort-property))) 432 (when (org-string-nw-p effort) 433 (floor (org-duration-to-minutes effort))))) 434 (t nil))) 435 (minutes (or (and (numberp opt) (number-to-string opt)) 436 (and (not (equal opt '(64))) 437 effort-minutes 438 (number-to-string effort-minutes)) 439 (and (consp opt) default-timer) 440 (and (stringp opt) opt) 441 (read-from-minibuffer 442 "How much time left? (minutes or h:mm:ss) " 443 (and (not (string-equal default-timer "0")) default-timer))))) 444 (when (string-match "\\`[0-9]+\\'" minutes) 445 (setq minutes (concat minutes ":00"))) 446 (if (not (string-match "[0-9]+" minutes)) 447 (org-timer-show-remaining-time) 448 (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes)))) 449 (if (and org-timer-countdown-timer 450 (not (or (equal opt '(16)) 451 (y-or-n-p "Replace current timer? ")))) 452 (message "No timer set") 453 (when (timerp org-timer-countdown-timer) 454 (cancel-timer org-timer-countdown-timer)) 455 (setq org-timer-countdown-timer-title 456 (org-timer--get-timer-title)) 457 (setq org-timer-countdown-timer 458 (org-timer--run-countdown-timer 459 secs org-timer-countdown-timer-title)) 460 (run-hooks 'org-timer-set-hook) 461 (setq org-timer-start-time (time-add nil secs)) 462 (setq org-timer-pause-time nil) 463 (org-timer-set-mode-line 'on)))))) 464 465 (defun org-timer--run-countdown-timer (secs title) 466 "Start countdown timer that will last SECS. 467 TITLE will be appended to the notification message displayed when 468 time is up." 469 (let ((msg (format "%s: time out" title)) 470 (sound org-clock-sound)) 471 (run-with-timer 472 secs nil (lambda () 473 (setq org-timer-countdown-timer nil 474 org-timer-start-time nil) 475 (org-notify msg sound) 476 (org-timer-set-mode-line 'off) 477 (run-hooks 'org-timer-done-hook))))) 478 479 (defun org-timer--get-timer-title () 480 "Construct timer title. 481 Try to use an Org header, otherwise use the buffer name." 482 (cond 483 ((derived-mode-p 'org-agenda-mode) 484 (let* ((marker (or (get-text-property (point) 'org-marker))) 485 (hdmarker (or (get-text-property (point) 'org-hd-marker) 486 marker))) 487 (when (and marker (marker-buffer marker)) 488 (with-current-buffer (marker-buffer marker) 489 (org-with-wide-buffer 490 (goto-char hdmarker) 491 (or (ignore-errors (org-get-heading)) 492 (buffer-name (buffer-base-buffer)))))))) 493 ((derived-mode-p 'org-mode) 494 (ignore-errors (org-get-heading))) 495 (t (buffer-name (buffer-base-buffer))))) 496 497 (provide 'org-timer) 498 499 ;; Local variables: 500 ;; generated-autoload-file: "org-loaddefs.el" 501 ;; End: 502 503 ;;; org-timer.el ends here