lisp/org-timer.el

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