diff options
Diffstat (limited to 'lisp/org/org-clock.el')
| -rw-r--r-- | lisp/org/org-clock.el | 547 |
1 files changed, 309 insertions, 238 deletions
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index a536d025c04..b386eb11652 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1,6 +1,6 @@ ;;; org-clock.el --- The time clocking code for Org-mode -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2015 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -26,11 +26,11 @@ ;; This file contains the time clocking code for Org-mode -(require 'org-exp) ;;; Code: (eval-when-compile (require 'cl)) +(require 'org) (declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) (declare-function notifications-notify "notifications" (&rest params)) @@ -95,6 +95,24 @@ clocking out." (repeat :tag "State list" (string :tag "TODO keyword")))) +(defcustom org-clock-rounding-minutes 0 + "Rounding minutes when clocking in or out. +The default value is 0 so that no rounding is done. +When set to a non-integer value, use the car of +`org-time-stamp-rounding-minutes', like for setting a time-stamp. + +E.g. if `org-clock-rounding-minutes' is set to 5, time is 14:47 +and you clock in: then the clock starts at 14:45. If you clock +out within the next 5 minutes, the clock line will be removed; +if you clock out 8 minutes after your clocked in, the clock +out time will be 14:50." + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (integer :tag "Minutes (0 for no rounding)") + (symbol :tag "Use `org-time-stamp-rounding-minutes'" 'same-as-time-stamp))) + (defcustom org-clock-out-remove-zero-time-clocks nil "Non-nil means remove the clock line when the resulting time is zero." :group 'org-clock @@ -141,7 +159,7 @@ state to switch it to." This is the string shown in the mode line when a clock is running. The function is called with point at the beginning of the headline." :group 'org-clock - :type 'function) + :type '(choice (const nil) (function))) (defcustom org-clock-string-limit 0 "Maximum length of clock strings in the mode line. 0 means no limit." @@ -177,7 +195,7 @@ Emacs initialization file." (const :tag "No persistence" nil))) (defcustom org-clock-persist-file (convert-standard-filename - "~/.emacs.d/org-clock-save.el") + (concat user-emacs-directory "org-clock-save.el")) "File to save clock data to." :group 'org-clock :type 'string) @@ -193,17 +211,17 @@ Emacs initialization file." :type 'boolean) (defcustom org-clock-sound nil - "Sound that will used for notifications. -Possible values: + "Sound to use for notifications. +Possible values are: -nil no sound played. -t standard Emacs beep -file name play this sound file. If not possible, fall back to beep" +nil No sound played +t Standard Emacs beep +file name Play this sound file, fall back to beep" :group 'org-clock :type '(choice (const :tag "No sound" nil) (const :tag "Standard beep" t) - (file :tag "Play sound file"))) + (file :tag "Play sound file"))) (define-obsolete-variable-alias 'org-clock-modeline-total 'org-clock-mode-line-total "24.3") @@ -226,7 +244,7 @@ auto Automatically, either `all', or `repeat' for repeating tasks" (const :tag "All task time" all) (const :tag "Automatically, `all' or since `repeat'" auto))) -(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) +(org-defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) (defcustom org-clock-task-overrun-text nil "Extra mode line text to indicate that the clock is overrun. The can be nil to indicate that instead of adding text, the clock time @@ -245,6 +263,7 @@ The function or program will be called with the notification string as argument." :group 'org-clock :type '(choice + (const nil) (string :tag "Program") (function :tag "Function"))) @@ -256,9 +275,11 @@ string as argument." (defcustom org-clocktable-defaults (list :maxlevel 2 - :lang org-export-default-language + :lang (or (org-bound-and-true-p org-export-default-language) "en") :scope 'file :block nil + :wstart 1 + :mstart 1 :tstart nil :tend nil :step nil @@ -341,13 +362,13 @@ play with them." "Format string for the total time cells." :group 'org-clock :version "24.1" - :type 'boolean) + :type 'string) (defcustom org-clock-file-time-cell-format "*%s*" "Format string for the file time cells." :group 'org-clock :version "24.1" - :type 'boolean) + :type 'string) (defcustom org-clock-clocked-in-display 'mode-line "When clocked in for a task, org-mode can display the current @@ -368,8 +389,8 @@ nil current clock is not displayed" (defcustom org-clock-frame-title-format '(t org-mode-line-string) "The value for `frame-title-format' when clocking in. -When `org-clock-clocked-in-display' is set to 'frame-title -or 'both, clocking in will replace `frame-title-format' with +When `org-clock-clocked-in-display' is set to `frame-title' +or `both', clocking in will replace `frame-title-format' with this value. Clocking out will restore `frame-title-format'. `org-frame-title-string' is a format string using the same @@ -378,6 +399,20 @@ specifications than `frame-title-format', which see." :group 'org-clock :type 'sexp) +(defcustom org-clock-x11idle-program-name "x11idle" + "Name of the program which prints X11 idle time in milliseconds. + +You can find x11idle.c in the contrib/scripts directory of the +Org git distribution. Or, you can do: + + sudo apt-get install xprintidle + +if you are using Debian." + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + (defvar org-clock-in-prepare-hook nil "Hook run when preparing the clock. This hook is run before anything happens to the task that @@ -389,7 +424,7 @@ to add an effort property.") "Hook run when stopping the current clock.") (defvar org-clock-cancel-hook nil - "Hook run when cancelling the current clock.") + "Hook run when canceling the current clock.") (defvar org-clock-goto-hook nil "Hook run when selecting the currently clocked-in entry.") (defvar org-clock-has-been-used nil @@ -403,11 +438,10 @@ to add an effort property.") (defvar org-clock-mode-line-timer nil) (defvar org-clock-idle-timer nil) (defvar org-clock-heading) ; defined in org.el -(defvar org-clock-heading-for-remember "") (defvar org-clock-start-time "") (defvar org-clock-leftover-time nil - "If non-nil, user cancelled a clock; this is when leftover time started.") + "If non-nil, user canceled a clock; this is when leftover time started.") (defvar org-clock-effort "" "Effort estimate of the currently clocking task.") @@ -481,46 +515,55 @@ of a different task.") "Hook called in task selection just before prompting the user.") (defun org-clock-select-task (&optional prompt) - "Select a task that recently was associated with clocking." + "Select a task that was recently associated with clocking." (interactive) - (let (sel-list rpl (i 0) s) - (save-window-excursion - (org-switch-to-buffer-other-window - (get-buffer-create "*Clock Task Select*")) - (erase-buffer) - (when (marker-buffer org-clock-default-task) - (insert (org-add-props "Default Task\n" nil 'face 'bold)) - (setq s (org-clock-insert-selection-line ?d org-clock-default-task)) - (push s sel-list)) - (when (marker-buffer org-clock-interrupted-task) - (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold)) - (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task)) - (push s sel-list)) - (when (org-clocking-p) - (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold)) - (setq s (org-clock-insert-selection-line ?c org-clock-marker)) - (push s sel-list)) - (insert (org-add-props "Recent Tasks\n" nil 'face 'bold)) - (mapc - (lambda (m) - (when (marker-buffer m) - (setq i (1+ i) - s (org-clock-insert-selection-line - (if (< i 10) - (+ i ?0) - (+ i (- ?A 10))) m)) - (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) - (push s sel-list))) - org-clock-history) - (run-hooks 'org-clock-before-select-task-hook) - (org-fit-window-to-buffer) - (message (or prompt "Select task for clocking:")) - (setq rpl (read-char-exclusive)) - (cond - ((eq rpl ?q) nil) - ((eq rpl ?x) nil) - ((assoc rpl sel-list) (cdr (assoc rpl sel-list))) - (t (error "Invalid task choice %c" rpl)))))) + (let (och chl sel-list rpl (i 0) s) + ;; Remove successive dups from the clock history to consider + (mapc (lambda (c) (if (not (equal c (car och))) (push c och))) + org-clock-history) + (setq och (reverse och) chl (length och)) + (if (zerop chl) + (user-error "No recent clock") + (save-window-excursion + (org-switch-to-buffer-other-window + (get-buffer-create "*Clock Task Select*")) + (erase-buffer) + (when (marker-buffer org-clock-default-task) + (insert (org-add-props "Default Task\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?d org-clock-default-task)) + (push s sel-list)) + (when (marker-buffer org-clock-interrupted-task) + (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task)) + (push s sel-list)) + (when (org-clocking-p) + (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?c org-clock-marker)) + (push s sel-list)) + (insert (org-add-props "Recent Tasks\n" nil 'face 'bold)) + (mapc + (lambda (m) + (when (marker-buffer m) + (setq i (1+ i) + s (org-clock-insert-selection-line + (if (< i 10) + (+ i ?0) + (+ i (- ?A 10))) m)) + (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) + (push s sel-list))) + och) + (run-hooks 'org-clock-before-select-task-hook) + (goto-char (point-min)) + ;; Set min-height relatively to circumvent a possible but in + ;; `fit-window-to-buffer' + (fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl))) + (message (or prompt "Select task for clocking:")) + (setq cursor-type nil rpl (read-char-exclusive)) + (cond + ((eq rpl ?q) nil) + ((eq rpl ?x) nil) + ((assoc rpl sel-list) (cdr (assoc rpl sel-list))) + (t (user-error "Invalid task choice %c" rpl))))))) (defun org-clock-insert-selection-line (i marker) "Insert a line for the clock selection menu. @@ -547,7 +590,7 @@ pointing to it." org-odd-levels-only) (length prefix))))))) (when (and cat task) - (insert (format "[%c] %-15s %s\n" i cat task)) + (insert (format "[%c] %-12s %s\n" i cat task)) (cons i marker))))) (defvar org-clock-task-overrun nil @@ -560,30 +603,33 @@ pointing to it." If an effort estimate was defined for the current item, use 01:30/01:50 format (clocked/estimated). If not, show simply the clocked time like 01:50." - (let* ((clocked-time (org-clock-get-clocked-time)) - (h (floor clocked-time 60)) - (m (- clocked-time (* 60 h)))) + (let ((clocked-time (org-clock-get-clocked-time))) (if org-clock-effort (let* ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort)) - (effort-h (floor effort-in-minutes 60)) - (effort-m (- effort-in-minutes (* effort-h 60))) (work-done-str (org-propertize - (format org-time-clocksum-format h m) + (org-minutes-to-clocksum-string clocked-time) 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text)) 'org-mode-line-clock-overrun 'org-mode-line-clock))) - (effort-str (format org-time-clocksum-format effort-h effort-m)) + (effort-str (org-minutes-to-clocksum-string effort-in-minutes)) (clockstr (org-propertize (concat " [%s/" effort-str "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") 'face 'org-mode-line-clock))) (format clockstr work-done-str)) - (org-propertize (format - (concat "[" org-time-clocksum-format " (%s)]") - h m org-clock-heading) + (org-propertize (concat "[" (org-minutes-to-clocksum-string clocked-time) + (format " (%s)" org-clock-heading) "]") 'face 'org-mode-line-clock)))) +(defun org-clock-get-last-clock-out-time () + "Get the last clock-out time for the current subtree." + (save-excursion + (let ((end (save-excursion (org-end-of-subtree)))) + (when (re-search-forward (concat org-clock-string + ".*\\]--\\(\\[[^]]+\\]\\)") end t) + (org-time-string-to-time (match-string 1)))))) + (defun org-clock-update-mode-line () (if org-clock-effort (org-clock-notify-once-if-expired) @@ -620,9 +666,12 @@ previous clocking intervals." "Add to or set the effort estimate of the item currently being clocked. VALUE can be a number of minutes, or a string with format hh:mm or mm. When the string starts with a + or a - sign, the current value of the effort -property will be changed by that amount. -This will update the \"Effort\" property of currently clocked item, and -the mode line." +property will be changed by that amount. If the effort value is expressed +as an `org-effort-durations' (e.g. \"3h\"), the modified value will be +converted to a hh:mm duration. + +This command will update the \"Effort\" property of the currently +clocked item, and the value displayed in the mode line." (interactive) (if (org-clock-is-active) (let ((current org-clock-effort) sign) @@ -646,7 +695,7 @@ the mode line." (setq value (- current value)) (if (equal ?+ sign) (setq value (+ current value))))) (setq value (max 0 value) - org-clock-effort (org-minutes-to-hh:mm-string value)) + org-clock-effort (org-minutes-to-clocksum-string value)) (org-entry-put org-clock-marker "Effort" org-clock-effort) (org-clock-update-mode-line) (message "Effort is now %s" org-clock-effort)) @@ -668,14 +717,16 @@ Notification is shown only once." (unless org-clock-notification-was-shown (setq org-clock-notification-was-shown t) (org-notify - (format "Task '%s' should be finished by now. (%s)" - org-clock-heading org-clock-effort) t)) + (format-message "Task `%s' should be finished by now. (%s)" + org-clock-heading org-clock-effort) + org-clock-sound)) (setq org-clock-notification-was-shown nil))))) (defun org-notify (notification &optional play-sound) - "Send a NOTIFICATION and maybe PLAY-SOUND." + "Send a NOTIFICATION and maybe PLAY-SOUND. +If PLAY-SOUND is non-nil, it overrides `org-clock-sound'." (org-show-notification notification) - (if play-sound (org-clock-play-sound))) + (if play-sound (org-clock-play-sound play-sound))) (defun org-show-notification (notification) "Show notification. @@ -700,21 +751,23 @@ use libnotify if available, or fall back on a message." ;; a fall back option (t (message "%s" notification)))) -(defun org-clock-play-sound () +(defun org-clock-play-sound (&optional clock-sound) "Play sound as configured by `org-clock-sound'. -Use alsa's aplay tool if available." - (cond - ((not org-clock-sound)) - ((eq org-clock-sound t) (beep t) (beep t)) - ((stringp org-clock-sound) - (let ((file (expand-file-name org-clock-sound))) - (if (file-exists-p file) - (if (executable-find "aplay") - (start-process "org-clock-play-notification" nil - "aplay" file) - (condition-case nil - (play-sound-file file) - (error (beep t) (beep t))))))))) +Use alsa's aplay tool if available. +If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." + (let ((org-clock-sound (or clock-sound org-clock-sound))) + (cond + ((not org-clock-sound)) + ((eq org-clock-sound t) (beep t) (beep t)) + ((stringp org-clock-sound) + (let ((file (expand-file-name org-clock-sound))) + (if (file-exists-p file) + (if (executable-find "aplay") + (start-process "org-clock-play-notification" nil + "aplay" file) + (condition-case nil + (play-sound-file file) + (error (beep t) (beep t)))))))))) (defvar org-clock-mode-line-entry nil "Information for the mode line about the running clock.") @@ -885,25 +938,29 @@ was started." (org-clock-jump-to-current-clock clock)) (unless org-clock-resolve-expert (with-output-to-temp-buffer "*Org Clock*" - (princ "Select a Clock Resolution Command: + (princ (format-message "Select a Clock Resolution Command: -i/q/C-g Ignore this question; the same as keeping all the idle time. +i/q Ignore this question; the same as keeping all the idle time. k/K Keep X minutes of the idle time (default is all). If this amount is less than the default, you will be clocked out that many minutes after the time that idling began, and then clocked back in at the present time. -g/G Indicate that you \"got back\" X minutes ago. This is quite - different from 'k': it clocks you out from the beginning of + +g/G Indicate that you “got back” X minutes ago. This is quite + different from `k': it clocks you out from the beginning of the idle period and clock you back in X minutes ago. + s/S Subtract the idle time from the current clock. This is the same as keeping 0 minutes. + C Cancel the open timer altogether. It will be as though you never clocked in. + j/J Jump to the current clock, to make manual adjustments. For all these options, using uppercase makes your final state -to be CLOCKED OUT."))) +to be CLOCKED OUT.")))) (org-fit-window-to-buffer (get-buffer-window "*Org Clock*")) (let (char-pressed) (when (featurep 'xemacs) @@ -990,9 +1047,9 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (lambda (clock) (format "Dangling clock started %d mins ago" - (floor - (/ (- (org-float-time (current-time)) - (org-float-time (cdr clock))) 60)))))) + (floor (- (org-float-time) + (org-float-time (cdr clock))) + 60))))) (or last-valid (cdr clock))))))))))) @@ -1010,13 +1067,15 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (defvar org-x11idle-exists-p ;; Check that x11idle exists (and (eq window-system 'x) - (eq (call-process-shell-command "command" nil nil nil "-v" "x11idle") 0) + (eq 0 (call-process-shell-command + (format "command -v %s" org-clock-x11idle-program-name))) ;; Check that x11idle can retrieve the idle time - (eq (call-process-shell-command "x11idle" nil nil nil) 0))) + ;; FIXME: Why "..-shell-command" rather than just `call-process'? + (eq 0 (call-process-shell-command org-clock-x11idle-program-name)))) (defun org-x11-idle-seconds () "Return the current X11 idle time in seconds." - (/ (string-to-number (shell-command-to-string "x11idle")) 1000)) + (/ (string-to-number (shell-command-to-string org-clock-x11idle-program-name)) 1000)) (defun org-user-idle-seconds () "Return the number of seconds the user has been idle for. @@ -1037,7 +1096,7 @@ This is performed after `org-clock-idle-time' minutes, to check if the user really wants to stay clocked in after being idle for so long." (when (and org-clock-idle-time (not org-clock-resolving-clocks) - org-clock-marker) + org-clock-marker (marker-buffer org-clock-marker)) (let* ((org-clock-user-idle-seconds (org-user-idle-seconds)) (org-clock-user-idle-start (time-subtract (current-time) @@ -1056,17 +1115,9 @@ so long." 60.0)))) org-clock-user-idle-start))))) -(defvar org-clock-current-task nil - "Task currently clocked in.") -(defun org-clock-set-current () - "Set `org-clock-current-task' to the task currently clocked in." - (setq org-clock-current-task (nth 4 (org-heading-components)))) - -(defun org-clock-delete-current () - "Reset `org-clock-current-task' to nil." - (setq org-clock-current-task nil)) - +(defvar org-clock-current-task nil "Task currently clocked in.") (defvar org-clock-out-time nil) ; store the time of the last clock-out +(defvar org--msg-extra) ;;;###autoload (defun org-clock-in (&optional select start-time) @@ -1086,7 +1137,7 @@ make this the default behavior.)" (catch 'abort (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) (org-clocking-p))) - ts selected-task target-pos (msg-extra "") + ts selected-task target-pos (org--msg-extra "") (leftover (and (not org-clock-resolving-clocks) org-clock-leftover-time))) @@ -1156,14 +1207,9 @@ make this the default behavior.)" (goto-char target-pos) (org-back-to-heading t) (or interrupting (move-marker org-clock-interrupted-task nil)) - (save-excursion - (forward-char) ;; make sure the marker is not at the - ;; beginning of the heading, since the - ;; user is liking to insert stuff here - ;; manually - (run-hooks 'org-clock-in-prepare-hook) - (org-clock-history-push)) - (org-clock-set-current) + (run-hooks 'org-clock-in-prepare-hook) + (org-clock-history-push) + (setq org-clock-current-task (nth 4 (org-heading-components))) (cond ((functionp org-clock-in-switch-to-state) (looking-at org-complex-heading-regexp) (let ((newstate (funcall org-clock-in-switch-to-state @@ -1174,30 +1220,22 @@ make this the default behavior.)" org-clock-in-switch-to-state "\\>")))) (org-todo org-clock-in-switch-to-state))) - (setq org-clock-heading-for-remember - (and (looking-at org-complex-heading-regexp) - (match-end 4) - (org-trim (buffer-substring (match-end 1) - (match-end 4))))) (setq org-clock-heading (cond ((and org-clock-heading-function (functionp org-clock-heading-function)) (funcall org-clock-heading-function)) - ((and (looking-at org-complex-heading-regexp) - (match-string 4)) + ((nth 4 (org-heading-components)) (replace-regexp-in-string "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" - (match-string 4))) + (match-string-no-properties 4))) (t "???"))) - (setq org-clock-heading (org-propertize org-clock-heading - 'face nil)) (org-clock-find-position org-clock-in-resume) (cond ((and org-clock-in-resume (looking-at (concat "^[ \t]*" org-clock-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" - " *\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) + " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) (message "Matched %s" (match-string 1)) (setq ts (concat "[" (match-string 1) "]")) (goto-char (match-end 1)) @@ -1233,11 +1271,12 @@ make this the default behavior.)" (y-or-n-p (format "You stopped another clock %d mins ago; start this one from then? " - (/ (- (org-float-time (current-time)) + (/ (- (org-float-time + (org-current-time org-clock-rounding-minutes t)) (org-float-time leftover)) 60))) leftover) start-time - (current-time))) + (org-current-time org-clock-rounding-minutes t))) (setq ts (org-insert-time-stamp org-clock-start-time 'with-hm 'inactive)))) (move-marker org-clock-marker (point) (buffer-base-buffer)) @@ -1270,7 +1309,7 @@ make this the default behavior.)" (setq org-clock-idle-timer nil)) (setq org-clock-idle-timer (run-with-timer 60 60 'org-resolve-clocks-if-idle)) - (message "Clock starts at %s - %s" ts msg-extra) + (message "Clock starts at %s - %s" ts org--msg-extra) (run-hooks 'org-clock-in-hook))))))) ;;;###autoload @@ -1288,8 +1327,9 @@ for a todo state to switch to, overriding the existing value (if (equal arg '(4)) (org-clock-in (org-clock-select-task)) (let ((start-time (if (or org-clock-continuously (equal arg '(16))) - (or org-clock-out-time (current-time)) - (current-time)))) + (or org-clock-out-time + (org-current-time org-clock-rounding-minutes t)) + (org-current-time org-clock-rounding-minutes t)))) (if (null org-clock-history) (message "No last clock") (let ((org-clock-in-switch-to-state @@ -1315,7 +1355,6 @@ for a todo state to switch to, overriding the existing value (org-back-to-heading t) (move-marker org-clock-default-task (point)))) -(defvar msg-extra) (defun org-clock-get-sum-start () "Return the time from which clock times should be counted. This is for the currently running clock as it is displayed @@ -1328,11 +1367,11 @@ decides which time to use." (lr (org-entry-get nil "LAST_REPEAT"))) (cond ((equal cmt "current") - (setq msg-extra "showing time in current clock instance") + (setq org--msg-extra "showing time in current clock instance") (current-time)) ((equal cmt "today") - (setq msg-extra "showing today's task time.") - (let* ((dt (decode-time (current-time)))) + (setq org--msg-extra "showing today's task time.") + (let* ((dt (decode-time))) (setq dt (append (list 0 0 0) (nthcdr 3 dt))) (if org-extend-today-until (setf (nth 2 dt) org-extend-today-until)) @@ -1340,12 +1379,12 @@ decides which time to use." ((or (equal cmt "all") (and (or (not cmt) (equal cmt "auto")) (not lr))) - (setq msg-extra "showing entire task time.") + (setq org--msg-extra "showing entire task time.") nil) ((or (equal cmt "repeat") (and (or (not cmt) (equal cmt "auto")) lr)) - (setq msg-extra "showing task time since last repeat.") + (setq org--msg-extra "showing task time since last repeat.") (if (not lr) nil (org-time-string-to-time lr))) @@ -1461,7 +1500,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." org-todo-keywords-1) nil t "DONE") org-clock-out-switch-to-state)) - (now (current-time)) + (now (org-current-time org-clock-rounding-minutes)) ts te s h m remove) (setq org-clock-out-time now) (save-excursion ; Do not replace this with `with-current-buffer'. @@ -1522,11 +1561,20 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." "\\>")))) (org-todo org-clock-out-switch-to-state)))))) (force-mode-line-update) - (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m - (if remove " => LINE REMOVED" "")) - (run-hooks 'org-clock-out-hook) + (message (concat "Clock stopped at %s after " + (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s") + te (if remove " => LINE REMOVED" "")) + (let ((h org-clock-out-hook)) + ;; If a closing note needs to be stored in the drawer + ;; where clocks are stored, let's temporarily disable + ;; `org-clock-remove-empty-clock-drawer' + (if (and (equal org-clock-into-drawer org-log-into-drawer) + (eq org-log-done 'note) + org-clock-out-when-done) + (setq h (delq 'org-clock-remove-empty-clock-drawer h))) + (mapc (lambda (f) (funcall f)) h)) (unless (org-clocking-p) - (org-clock-delete-current))))))) + (setq org-clock-current-task nil))))))) (add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer) @@ -1545,19 +1593,22 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (org-remove-empty-drawer-at clock-drawer (point)) (forward-line 1)))))) -(defun org-clock-timestamps-up nil - "Increase CLOCK timestamps at cursor." - (interactive) - (org-clock-timestamps-change 'up)) +(defun org-clock-timestamps-up (&optional n) + "Increase CLOCK timestamps at cursor. +Optional argument N tells to change by that many units." + (interactive "P") + (org-clock-timestamps-change 'up n)) -(defun org-clock-timestamps-down nil - "Increase CLOCK timestamps at cursor." - (interactive) - (org-clock-timestamps-change 'down)) +(defun org-clock-timestamps-down (&optional n) + "Increase CLOCK timestamps at cursor. +Optional argument N tells to change by that many units." + (interactive "P") + (org-clock-timestamps-change 'down n)) -(defun org-clock-timestamps-change (updown) +(defun org-clock-timestamps-change (updown &optional n) "Change CLOCK timestamps synchronously at cursor. -UPDOWN tells whether to change 'up or 'down." +UPDOWN tells whether to change 'up or 'down. +Optional argument N tells to change by that many units." (setq org-ts-what nil) (when (org-at-timestamp-p t) (let ((tschange (if (eq updown 'up) 'org-timestamp-up @@ -1573,9 +1624,9 @@ UPDOWN tells whether to change 'up or 'down." (if (<= begts2 (point)) (setq updatets1 t)) (if (not ts2) ;; fall back on org-timestamp-up if there is only one - (funcall tschange) + (funcall tschange n) ;; setq this so that (boundp 'org-ts-what is non-nil) - (funcall tschange) + (funcall tschange n) (let ((ts (if updatets1 ts2 ts1)) (begts (if updatets1 begts1 begts2))) (setq tdiff @@ -1606,7 +1657,8 @@ UPDOWN tells whether to change 'up or 'down." (save-excursion ; Do not replace this with `with-current-buffer'. (org-no-warnings (set-buffer (org-clocking-buffer))) (goto-char org-clock-marker) - (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")) + (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*") + (line-beginning-position)) (progn (delete-region (1- (point-at-bol)) (point-at-eol)) (org-remove-empty-drawer-at "LOGBOOK" (point))) (message "Clock gone, cancel the timer anyway") @@ -1620,6 +1672,12 @@ UPDOWN tells whether to change 'up or 'down." (message "Clock canceled") (run-hooks 'org-clock-cancel-hook)) +(defcustom org-clock-goto-before-context 2 + "Number of lines of context to display before currently clocked-in entry. +This applies when using `org-clock-goto'." + :group 'org-clock + :type 'integer) + ;;;###autoload (defun org-clock-goto (&optional select) "Go to the currently clocked-in entry, or to the most recently clocked one. @@ -1643,7 +1701,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (org-show-entry) (org-back-to-heading t) (org-cycle-hide-drawers 'children) - (recenter) + (recenter org-clock-goto-before-context) (org-reveal) (if recent (message "No running clock, this is the most recently clocked task")) @@ -1669,7 +1727,7 @@ each headline in the time range with point at the headline. Headlines for which HEADLINE-FILTER returns nil are excluded from the clock summation. PROPNAME lets you set a custom text property instead of :org-clock-minutes." (interactive) - (org-unmodified + (org-with-silent-modifications (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" org-clock-string "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) @@ -1784,12 +1842,9 @@ Use \\[org-clock-remove-overlays] to remove the subtree times." (when org-remove-highlights-with-change (org-add-hook 'before-change-functions 'org-clock-remove-overlays nil 'local)))) - (if org-time-clocksum-use-fractional - (message (concat "Total file time: " org-time-clocksum-fractional-format - " (%d hours and %d minutes)") - (/ (+ (* h 60.0) m) 60.0) h m) - (message (concat "Total file time: " org-time-clocksum-format - " (%d hours and %d minutes)") h m h m)))) + (message (concat "Total file time: " + (org-minutes-to-clocksum-string org-clock-file-total-minutes) + " (%d hours and %d minutes)") h m))) (defvar org-clock-overlays nil) (make-variable-buffer-local 'org-clock-overlays) @@ -1799,27 +1854,20 @@ Use \\[org-clock-remove-overlays] to remove the subtree times." If LEVEL is given, prefix time with a corresponding number of stars. This creates a new overlay and stores it in `org-clock-overlays', so that it will be easy to remove." - (let* ((c 60) (h (floor (/ time 60))) (m (- time (* 60 h))) - (l (if level (org-get-valid-level level 0) 0)) - (fmt (concat "%s " (if org-time-clocksum-use-fractional - org-time-clocksum-fractional-format - org-time-clocksum-format) "%s")) - (off 0) + (let* ((l (if level (org-get-valid-level level 0) 0)) ov tx) - (org-move-to-column c) - (unless (eolp) (skip-chars-backward "^ \t")) - (skip-chars-backward " \t") - (setq ov (make-overlay (point-at-bol) (point-at-eol)) - tx (concat (buffer-substring (point-at-bol) (point)) - (make-string (+ off (max 0 (- c (current-column)))) ?.) - (org-add-props (if org-time-clocksum-use-fractional - (format fmt - (make-string l ?*) - (/ (+ (* h 60.0) m) 60.0) - (make-string (- 16 l) ?\ )) - (format fmt - (make-string l ?*) h m - (make-string (- 16 l) ?\ ))) + (beginning-of-line) + (when (looking-at org-complex-heading-regexp) + (goto-char (match-beginning 4))) + (setq ov (make-overlay (point) (point-at-eol)) + tx (concat (buffer-substring-no-properties (point) (match-end 4)) + (make-string + (max 0 (- (- 60 (current-column)) + (- (match-end 4) (match-beginning 4)) + (length (org-get-at-bol 'line-prefix)))) ?.) + (org-add-props (concat (make-string l ?*) " " + (org-minutes-to-clocksum-string time) + (make-string (- 16 l) ?\ )) (list 'face 'org-clock-overlay)) "")) (if (not (featurep 'xemacs)) @@ -1828,6 +1876,7 @@ will be easy to remove." (overlay-put ov 'end-glyph (make-glyph tx))) (push ov org-clock-overlays))) +;;;###autoload (defun org-clock-remove-overlays (&optional beg end noremove) "Remove the occur highlights from the buffer. BEG and END are ignored. If NOREMOVE is nil, remove this function @@ -1882,7 +1931,7 @@ fontified, and then returned." (org-mode) (org-create-dblock props) (org-update-dblock) - (font-lock-fontify-buffer) + (org-font-lock-ensure) (forward-line 2) (buffer-substring (point) (progn (re-search-forward "^[ \t]*#\\+END" nil t) @@ -1969,20 +2018,27 @@ buffer and update it." ((> startday 4) (list 39 startday year))))))) -(defun org-clock-special-range (key &optional time as-strings) +(defun org-clock-special-range (key &optional time as-strings wstart mstart) "Return two times bordering a special time range. Key is a symbol specifying the range and can be one of `today', `yesterday', `thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'. -A week starts Monday 0:00 and ends Sunday 24:00. -The range is determined relative to TIME. TIME defaults to the current time. +By default, a week starts Monday 0:00 and ends Sunday 24:00. +The range is determined relative to TIME, which defaults to current time. The return value is a cons cell with two internal times like the ones -returned by `current time' or `encode-time'. if AS-STRINGS is non-nil, -the returned times will be formatted strings." +returned by `current time' or `encode-time'. +If AS-STRINGS is non-nil, the returned times will be formatted strings. +If WSTART is non-nil, use this number to specify the starting day of a +week (monday is 1). +If MSTART is non-nil, use this number to specify the starting day of a +month (1 is the first day of the month). +If you can combine both, the month starting day will have priority." (if (integerp key) (setq key (intern (number-to-string key)))) - (let* ((tm (decode-time (or time (current-time)))) + (let* ((tm (decode-time time)) (s 0) (m (nth 1 tm)) (h (nth 2 tm)) (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) (dow (nth 6 tm)) + (ws (or wstart 1)) + (ms (or mstart 1)) (skey (symbol-name key)) (shift 0) (q (cond ((>= (nth 4 tm) 10) 4) @@ -2037,20 +2093,21 @@ the returned times will be formatted strings." ((memq key '(day today)) (setq d (+ d shift) h 0 m 0 h1 24 m1 0)) ((memq key '(week thisweek)) - (setq diff (+ (* -7 shift) (if (= dow 0) 6 (1- dow))) + (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))) m 0 h 0 d (- d diff) d1 (+ 7 d))) ((memq key '(month thismonth)) - (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0)) + (setq d (or ms 1) h 0 m 0 d1 (or ms 1) + month (+ month shift) month1 (1+ month) h1 0 m1 0)) ((memq key '(quarter thisq)) - ; compute if this shift remains in this year - ; if not, compute how many years and quarters we have to shift (via floor*) - ; and compute the shifted years, months and quarters + ;; Compute if this shift remains in this year. If not, compute + ;; how many years and quarters we have to shift (via floor*) and + ;; compute the shifted years, months and quarters. (cond ((< (+ (- q 1) shift) 0) ; shift not in this year (setq interval (* -1 (+ (- q 1) shift))) - ; set tmp to ((years to shift) (quarters to shift)) + ;; Set tmp to ((years to shift) (quarters to shift)). (setq tmp (org-floor* interval 4)) - ; due to the use of floor, 0 quarters actually means 4 + ;; Due to the use of floor, 0 quarters actually means 4. (if (= 0 (nth 1 tmp)) (setq shiftedy (- y (nth 0 tmp)) shiftedm 1 @@ -2080,8 +2137,7 @@ the returned times will be formatted strings." ((memq key '(year thisyear)) (setq txt (format-time-string "the year %Y" ts))) ((memq key '(quarter thisq)) - (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))) - ) + (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))) (if as-strings (list (format-time-string fm ts) (format-time-string fm te) txt) (list ts te txt)))) @@ -2093,6 +2149,7 @@ the returned times will be formatted strings." ((= n 3) "3rd") ((= n 4) "4th"))) +;;;###autoload (defun org-clocktable-shift (dir n) "Try to shift the :block date of the clocktable at point. Point must be in the #+BEGIN: line of a clocktable, or this function @@ -2186,6 +2243,8 @@ the currently selected interval size." (te (plist-get params :tend)) (link (plist-get params :link)) (maxlevel (or (plist-get params :maxlevel) 3)) + (ws (plist-get params :wstart)) + (ms (plist-get params :mstart)) (step (plist-get params :step)) (timestamp (plist-get params :timestamp)) (formatter (or (plist-get params :formatter) @@ -2196,7 +2255,7 @@ the currently selected interval size." ;; Check if we need to do steps (when block ;; Get the range text for the header - (setq cc (org-clock-special-range block nil t) + (setq cc (org-clock-special-range block nil t ws ms) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) (when step ;; Write many tables, in steps @@ -2276,7 +2335,8 @@ from the dynamic block definition." ;; well-defined number of columns... (let* ((hlchars '((1 . "*") (2 . "/"))) (lwords (assoc (or (plist-get params :lang) - org-export-default-language) + (org-bound-and-true-p org-export-default-language) + "en") org-clock-clocktable-language-setup)) (multifile (plist-get params :multifile)) (block (plist-get params :block)) @@ -2284,10 +2344,14 @@ from the dynamic block definition." (te (plist-get params :tend)) (header (plist-get params :header)) (narrow (plist-get params :narrow)) + (ws (or (plist-get params :wstart) 1)) + (ms (or (plist-get params :mstart) 1)) (link (plist-get params :link)) (maxlevel (or (plist-get params :maxlevel) 3)) (emph (plist-get params :emphasize)) (level-p (plist-get params :level)) + (org-time-clocksum-use-effort-durations + (plist-get params :effort-durations)) (timestamp (plist-get params :timestamp)) (properties (plist-get params :properties)) (ntcol (max 1 (or (plist-get params :tcolumns) 100))) @@ -2326,7 +2390,7 @@ from the dynamic block definition." (when block ;; Get the range text for the header - (setq range-text (nth 2 (org-clock-special-range block nil t)))) + (setq range-text (nth 2 (org-clock-special-range block nil t ws ms)))) ;; Compute the total time (setq total-time (apply '+ (mapcar 'cadr tables))) @@ -2339,13 +2403,14 @@ from the dynamic block definition." (or header ;; Format the standard header (concat + "#+CAPTION: " (nth 9 lwords) " [" (substring (format-time-string (cdr org-time-stamp-formats)) 1 -1) "]" (if block (concat ", for " range-text ".") "") - "\n\n"))) + "\n"))) ;; Insert the narrowing line (when (and narrow (integerp narrow) (not narrow-cut-p)) @@ -2378,7 +2443,7 @@ from the dynamic block definition." (if properties (make-string (length properties) ?|) "") ; properties columns, maybe (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline (format org-clock-total-time-cell-format - (org-minutes-to-hh:mm-string (or total-time 0))) ; the time + (org-minutes-to-clocksum-string (or total-time 0))) ; the time "|\n") ; close line ;; Now iterate over the tables and insert the data @@ -2402,7 +2467,7 @@ from the dynamic block definition." (if level-p "| " "") ; level column, maybe (if timestamp "| " "") ; timestamp column, maybe (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time + (org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time ;; Get the list of node entries and iterate over it (setq entries (nth 2 tbl)) @@ -2435,7 +2500,7 @@ from the dynamic block definition." hlc headline hlc "|" ; headline (make-string (min (1- ntcol) (or (- level 1))) ?|) ; empty fields for higher levels - hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time + hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time "|\n" ; close line ))))) ;; When exporting subtrees or regions the region might be @@ -2495,26 +2560,25 @@ from the dynamic block definition." total-time)) (defun org-clocktable-indent-string (level) - (if (= level 1) - "" - (let ((str "\\__")) - (while (> level 2) - (setq level (1- level) - str (concat str "___"))) - (concat str " ")))) + (if (= level 1) "" + (let ((str " ")) + (dotimes (k (1- level) str) + (setq str (concat "\\emsp" str)))))) (defun org-clocktable-steps (params) "Step through the range to make a number of clock tables." (let* ((p1 (copy-sequence params)) (ts (plist-get p1 :tstart)) (te (plist-get p1 :tend)) + (ws (plist-get p1 :wstart)) + (ms (plist-get p1 :mstart)) (step0 (plist-get p1 :step)) (step (cdr (assoc step0 '((day . 86400) (week . 604800))))) (stepskip0 (plist-get p1 :stepskip0)) (block (plist-get p1 :block)) - cc range-text step-time) + cc range-text step-time tsb) (when block - (setq cc (org-clock-special-range block nil t) + (setq cc (org-clock-special-range block nil t ws ms) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) (cond ((numberp ts) @@ -2532,17 +2596,21 @@ from the dynamic block definition." (te (setq te (org-float-time (apply 'encode-time (org-parse-time-string te)))))) + (setq tsb + (if (eq step0 'week) + (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws))) + ts)) (setq p1 (plist-put p1 :header "")) (setq p1 (plist-put p1 :step nil)) (setq p1 (plist-put p1 :block nil)) - (while (< ts te) + (while (< tsb te) (or (bolp) (insert "\n")) (setq p1 (plist-put p1 :tstart (format-time-string (org-time-stamp-format nil t) - (seconds-to-time ts)))) + (seconds-to-time (max tsb ts))))) (setq p1 (plist-put p1 :tend (format-time-string (org-time-stamp-format nil t) - (seconds-to-time (setq ts (+ ts step)))))) + (seconds-to-time (min te (setq tsb (+ tsb step))))))) (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ") (plist-get p1 :tstart) "\n") @@ -2584,6 +2652,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time (timestamp (plist-get params :timestamp)) (ts (plist-get params :tstart)) (te (plist-get params :tend)) + (ws (plist-get params :wstart)) + (ms (plist-get params :mstart)) (block (plist-get params :block)) (link (plist-get params :link)) (tags (plist-get params :tags)) @@ -2595,7 +2665,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time (setq org-clock-file-total-minutes nil) (when block - (setq cc (org-clock-special-range block nil t) + (setq cc (org-clock-special-range block nil t ws ms) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts))) (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) @@ -2604,10 +2674,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time (when (and te (listp te)) (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) ;; Now the times are strings we can parse. - (if ts (setq ts (org-float-time - (apply 'encode-time (org-parse-time-string ts))))) - (if te (setq te (org-float-time - (apply 'encode-time (org-parse-time-string te))))) + (if ts (setq ts (org-matcher-time ts))) + (if te (setq te (org-matcher-time te))) (save-excursion (org-clock-sum ts te (unless (null matcher) @@ -2637,9 +2705,13 @@ TIME: The sum of all time spend in this tree, in minutes. This time (format "file:%s::%s" (buffer-file-name) (save-match-data - (org-make-org-heading-search-string - (match-string 2)))) - (match-string 2))) + (match-string 2))) + (org-make-org-heading-search-string + (replace-regexp-in-string + org-bracket-link-regexp + (lambda (m) (or (match-string 3 m) + (match-string 1 m))) + (match-string 2))))) tsp (when timestamp (setq props (org-entry-properties (point))) (or (cdr (assoc "SCHEDULED" props)) @@ -2686,6 +2758,7 @@ This function is made for clock tables." (defvar org-clock-loaded nil "Was the clock file loaded?") +;;;###autoload (defun org-clock-update-time-maybe () "If this is a CLOCK line, update it and return t. Otherwise, return nil." @@ -2742,8 +2815,8 @@ The details of what will be saved are regulated by the variable (delete-region (point-min) (point-max)) ;;Store clock (insert (format ";; org-persist.el - %s at %s\n" - system-name (format-time-string - (cdr org-time-stamp-formats)))) + (system-name) (format-time-string + (cdr org-time-stamp-formats)))) (if (and (memq org-clock-persist '(t clock)) (setq b (org-clocking-buffer)) (setq b (or (buffer-base-buffer b) b)) @@ -2751,9 +2824,7 @@ The details of what will be saved are regulated by the variable (buffer-file-name b) (or (not org-clock-persist-query-save) (y-or-n-p (concat "Save current clock (" - (substring-no-properties - org-clock-heading) - ") ")))) + org-clock-heading ") ")))) (insert "(setq resume-clock '(\"" (buffer-file-name (org-clocking-buffer)) "\" . " (int-to-string (marker-position org-clock-marker)) |