diff options
Diffstat (limited to 'lisp/org-timer.el')
| -rw-r--r-- | lisp/org-timer.el | 266 |
1 files changed, 160 insertions, 106 deletions
diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 8161699..2c51b42 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -1,4 +1,4 @@ -;;; org-timer.el --- The relative timer code for Org-mode +;;; org-timer.el --- Timer code for Org mode ;; Copyright (C) 2008-2014 Free Software Foundation, Inc. @@ -24,13 +24,20 @@ ;; ;;; Commentary: -;; This file contains the relative timer code for Org-mode +;; 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. ;;; Code: (require 'org) +(require 'org-clock) -(declare-function org-notify "org-clock" (notification &optional play-sound)) (declare-function org-agenda-error "org-agenda" ()) (defvar org-timer-start-time nil @@ -39,22 +46,32 @@ (defvar org-timer-pause-time nil "Time when the timer was paused.") +(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.") + (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 -the value of the relative timer." +the value of the timer." :group 'org-time :type 'string) -(defcustom org-timer-default-timer 0 - "The default timer when a timer is set. +(defcustom org-timer-default-timer "0" + "The default timer when a timer is set, in minutes or hh:mm:ss format. When 0, the user is prompted for a value." :group 'org-time - :version "24.1" - :type 'number) + :version "25.1" + :package-version '(Org . "8.3") + :type 'string) (defcustom org-timer-display 'mode-line "When a timer is running, org-mode can display it in the mode @@ -76,13 +93,13 @@ nil current timer is not displayed" "Hook run after relative timer is started.") (defvar org-timer-stop-hook nil - "Hook run before relative timer is stopped.") + "Hook run before relative or countdown timer is stopped.") (defvar org-timer-pause-hook nil - "Hook run before relative timer is paused.") + "Hook run before relative or countdown timer is paused.") (defvar org-timer-continue-hook nil - "Hook run after relative timer is continued.") + "Hook run after relative or countdown timer is continued.") (defvar org-timer-set-hook nil "Hook run after countdown timer is set.") @@ -90,9 +107,6 @@ nil current timer is not displayed" (defvar org-timer-done-hook nil "Hook run after countdown timer reaches zero.") -(defvar org-timer-cancel-hook nil - "Hook run before countdown timer is canceled.") - ;;;###autoload (defun org-timer-start (&optional offset) "Set the starting time for the relative timer to now. @@ -105,8 +119,12 @@ 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") - (if (equal offset '(16)) - (call-interactively 'org-timer-change-times-in-region) + (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 (let (delta def s) (if (not offset) (setq org-timer-start-time (current-time)) @@ -123,47 +141,66 @@ the region 0:00:00." (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) (setq org-timer-start-time (seconds-to-time - (- (org-float-time) delta)))) + ;; Pass `current-time' result to `org-float-time' + ;; (instead of calling without arguments) so that only + ;; `current-time' has to be overriden in tests. + (- (org-float-time (current-time)) delta)))) + (setq org-timer-pause-time nil) (org-timer-set-mode-line 'on) (message "Timer start time set to %s, current value is %s" (format-time-string "%T" org-timer-start-time) (org-timer-secs-to-hms (or delta 0))) - (run-hooks 'org-timer-start-hook)))) + (run-hooks 'org-timer-start-hook))))) (defun org-timer-pause-or-continue (&optional stop) - "Pause or continue the relative timer. + "Pause or continue the relative or countdown timer. With prefix arg STOP, stop it entirely." (interactive "P") (cond (stop (org-timer-stop)) ((not org-timer-start-time) (error "No timer is running")) (org-timer-pause-time - ;; timer is paused, continue - (setq org-timer-start-time - (seconds-to-time - (- - (org-float-time) - (- (org-float-time org-timer-pause-time) - (org-float-time org-timer-start-time)))) - 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))) + (let ((start-secs (org-float-time org-timer-start-time)) + (pause-secs (org-float-time org-timer-pause-time))) + (if org-timer-countdown-timer + (progn + (let ((new-secs (- start-secs pause-secs))) + (setq org-timer-countdown-timer + (org-timer--run-countdown-timer + new-secs org-timer-countdown-timer-title)) + (setq org-timer-start-time + (time-add (current-time) (seconds-to-time new-secs))))) + (setq org-timer-start-time + ;; Pass `current-time' result to `org-float-time' + ;; (instead of calling without arguments) so that only + ;; `current-time' has to be overriden in tests. + (seconds-to-time (- (org-float-time (current-time)) + (- pause-secs start-secs))))) + (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)))) (t ;; pause timer + (when org-timer-countdown-timer + (cancel-timer org-timer-countdown-timer) + (setq org-timer-countdown-timer 'pause)) (run-hooks 'org-timer-pause-hook) (setq org-timer-pause-time (current-time)) (org-timer-set-mode-line 'pause) (message "Timer paused at %s" (org-timer-value-string))))) -(defvar org-timer-current-timer nil) (defun org-timer-stop () - "Stop the relative timer." + "Stop the relative or countdown timer." (interactive) + (unless org-timer-start-time + (user-error "No timer running")) + (when (timerp org-timer-countdown-timer) + (cancel-timer org-timer-countdown-timer)) (run-hooks 'org-timer-stop-hook) (setq org-timer-start-time nil org-timer-pause-time nil - org-timer-current-timer nil) + org-timer-countdown-timer nil) (org-timer-set-mode-line 'off) (message "Timer stopped")) @@ -179,11 +216,13 @@ that was not started at the correct moment. If NO-INSERT-P is non-nil, return the string instead of inserting it in the buffer." (interactive "P") - (when (or (equal restart '(4)) (not org-timer-start-time)) - (org-timer-start)) - (if no-insert-p - (org-timer-value-string) - (insert (org-timer-value-string)))) + (if (equal restart '(16)) + (org-timer-start restart) + (when (or (equal restart '(4)) (not org-timer-start-time)) + (org-timer-start)) + (if no-insert-p + (org-timer-value-string) + (insert (org-timer-value-string))))) (defun org-timer-value-string () "Set the timer string." @@ -191,11 +230,13 @@ it in the buffer." (org-timer-secs-to-hms (abs (floor (org-timer-seconds)))))) -(defvar org-timer-timer-is-countdown nil) (defun org-timer-seconds () - (if org-timer-timer-is-countdown + ;; Pass `current-time' result to `org-float-time' (instead of + ;; calling without arguments) so that only `current-time' has to be + ;; overriden in tests. + (if org-timer-countdown-timer (- (org-float-time org-timer-start-time) - (org-float-time (current-time))) + (org-float-time (or org-timer-pause-time (current-time)))) (- (org-float-time (or org-timer-pause-time (current-time))) (org-float-time org-timer-start-time)))) @@ -290,7 +331,7 @@ If the integer is negative, the string will start with \"-\"." (defvar org-timer-mode-line-string nil) (defun org-timer-set-mode-line (value) - "Set the mode-line display of the relative timer. + "Set the mode-line display for relative or countdown timer. VALUE can be `on', `off', or `pause'." (when (or (eq org-timer-display 'mode-line) (eq org-timer-display 'both)) @@ -349,103 +390,116 @@ VALUE can be `on', `off', or `pause'." (concat " <" (substring (org-timer-value-string) 0 -1) ">")) (force-mode-line-update))) -(defun org-timer-cancel-timer () - "Cancel the current timer." - (interactive) - (when (eval org-timer-current-timer) - (run-hooks 'org-timer-cancel-hook) - (cancel-timer org-timer-current-timer) - (setq org-timer-current-timer nil) - (setq org-timer-timer-is-countdown nil) - (org-timer-set-mode-line 'off)) - (message "Last timer canceled")) - (defun org-timer-show-remaining-time () "Display the remaining time before the timer ends." (interactive) (require 'time) - (if (not org-timer-current-timer) + (if (not org-timer-countdown-timer) (message "No timer set") (let* ((rtime (decode-time - (time-subtract (timer--time org-timer-current-timer) + (time-subtract (timer--time org-timer-countdown-timer) (current-time)))) (rsecs (nth 0 rtime)) (rmins (nth 1 rtime))) (message "%d minute(s) %d seconds left before next time out" rmins rsecs)))) -(defvar org-clock-sound) - ;;;###autoload (defun org-timer-set-timer (&optional opt) - "Prompt for a duration and set a timer. + "Prompt for a duration in minutes or hh:mm:ss and set a timer. -If `org-timer-default-timer' is not zero, suggest this value as +If `org-timer-default-timer' is not \"0\", suggest this value as the default duration for the timer. If a timer is already set, prompt the user if she wants to replace it. Called with a numeric prefix argument, use this numeric value as -the duration of the timer. +the duration of the timer in minutes. 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 -replace any running timer." +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." (interactive "P") - (let ((minutes (or (and (numberp opt) (number-to-string opt)) - (and (listp opt) (not (null opt)) - (number-to-string org-timer-default-timer)) - (read-from-minibuffer - "How many minutes left? " - (if (not (eq org-timer-default-timer 0)) - (number-to-string org-timer-default-timer)))))) + (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)) + (effort-minutes (ignore-errors (org-get-at-eol 'effort-minutes 1))) + (minutes (or (and (not (equal opt '(64))) + effort-minutes + (number-to-string effort-minutes)) + (and (numberp opt) (number-to-string opt)) + (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"))) (if (not (string-match "[0-9]+" minutes)) (org-timer-show-remaining-time) - (let* ((mins (string-to-number (match-string 0 minutes))) - (secs (* mins 60)) - (hl (cond - ((string-match "Org Agenda" (buffer-name)) - (let* ((marker (or (get-text-property (point) 'org-marker) - (org-agenda-error))) - (hdmarker (or (get-text-property (point) 'org-hd-marker) - marker)) - (pos (marker-position marker))) - (with-current-buffer (marker-buffer marker) - (widen) - (goto-char pos) - (org-show-entry) - (or (ignore-errors (org-get-heading)) - (concat "File:" (file-name-nondirectory (buffer-file-name))))))) - ((derived-mode-p 'org-mode) - (or (ignore-errors (org-get-heading)) - (concat "File:" (file-name-nondirectory (buffer-file-name))))) - (t (error "Not in an Org buffer")))) - timer-set) - (if (or (and org-timer-current-timer - (or (equal opt '(16)) - (y-or-n-p "Replace current timer? "))) - (not org-timer-current-timer)) + (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes))) + (hl (org-timer--get-timer-title))) + (if (or (not org-timer-countdown-timer) + (equal opt '(16)) + (y-or-n-p "Replace current timer? ")) (progn - (require 'org-clock) - (when org-timer-current-timer - (cancel-timer org-timer-current-timer)) - (setq org-timer-current-timer - (run-with-timer - secs nil `(lambda () - (setq org-timer-current-timer nil) - (org-notify ,(format "%s: time out" hl) ,org-clock-sound) - (setq org-timer-timer-is-countdown nil) - (org-timer-set-mode-line 'off) - (run-hooks 'org-timer-done-hook)))) + (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) - (setq org-timer-timer-is-countdown t - org-timer-start-time - (time-add (current-time) (seconds-to-time (* mins 60)))) + (setq org-timer-start-time + (time-add (current-time) (seconds-to-time secs))) + (setq org-timer-pause-time nil) (org-timer-set-mode-line 'on)) (message "No timer set")))))) +(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 () + "Construct timer title from heading or file name of Org buffer." + (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)))) + (t (error "Not in an Org buffer")))) + (provide 'org-timer) ;; Local variables: |