;;; org-clock.el --- The time clocking code for Org-mode
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.31a
+;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
;; This file contains the time clocking code for Org-mode
(require 'org)
+;;; Code:
+
(eval-when-compile
- (require 'cl)
- (require 'calendar))
+ (require 'cl))
-(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
+(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
+(declare-function notifications-notify "notifications" (&rest params))
(defvar org-time-stamp-formats)
(defgroup org-clock nil
(defcustom org-clock-out-when-done t
"When non-nil, clock will be stopped when the clocked entry is marked DONE.
-A nil value means, clock will keep running until stopped explicitly with
-`C-c C-x C-o', or until the clock is started in a different item."
+DONE here means any DONE-like state.
+A nil value means clock will keep running until stopped explicitly with
+`C-c C-x C-o', or until the clock is started in a different item.
+Instead of t, this can also be a list of TODO states that should trigger
+clocking out."
:group 'org-clock
- :type 'boolean)
+ :type '(choice
+ (const :tag "No" nil)
+ (const :tag "Yes, when done" t)
+ (repeat :tag "State list"
+ (string :tag "TODO keyword"))))
(defcustom org-clock-out-remove-zero-time-clocks nil
- "Non-nil means, remove the clock line when the resulting time is zero."
+ "Non-nil means remove the clock line when the resulting time is zero."
:group 'org-clock
:type 'boolean)
(defcustom org-clock-in-switch-to-state nil
"Set task to a special todo state while clocking it.
The value should be the state to which the entry should be
-switched. If the value is a function, it must take one
+switched. If the value is a function, it must take one
parameter (the current TODO state of the item) and return the
state to switch it to."
:group 'org-clock
(defcustom org-clock-out-switch-to-state nil
"Set task to a special todo state after clocking out.
The value should be the state to which the entry should be
-switched. If the value is a function, it must take one
+switched. If the value is a function, it must take one
parameter (the current TODO state of the item) and return the
state to switch it to."
:group 'org-clock
:type 'integer)
(defcustom org-clock-goto-may-find-recent-task t
- "Non-nil means, `org-clock-goto' can go to recent task if no active clock."
+ "Non-nil means `org-clock-goto' can go to recent task if no active clock."
:group 'org-clock
:type 'boolean)
:type 'function)
(defcustom org-clock-string-limit 0
- "Maximum length of clock strings in the modeline. 0 means no limit."
+ "Maximum length of clock strings in the modeline. 0 means no limit."
:group 'org-clock
:type 'integer)
:type 'boolean)
(defcustom org-clock-persist nil
- "When non-nil, save the running clock when emacs is closed.
-The clock is resumed when emacs restarts.
+ "When non-nil, save the running clock when Emacs is closed.
+The clock is resumed when Emacs restarts.
When this is t, both the running clock, and the entire clock
history are saved. When this is the symbol `clock', only the
running clock is saved.
:group 'org-clock
:type '(choice
(const :tag "Just the running clock" clock)
+ (const :tag "Just the history" history)
(const :tag "Clock and history" t)
(const :tag "No persistence" nil)))
Allowed values are:
current Only the time in the current instance of the clock
-today All time clocked inot this task today
+today All time clocked into this task today
repeat All time clocked into this task since last repeat
all All time ever recorded for this task
-auto Automtically, either `all', or `repeat' for repeating tasks"
+auto Automatically, either `all', or `repeat' for repeating tasks"
:group 'org-clock
:type '(choice
(const :tag "Current clock" current)
(const :tag "All task time" all)
(const :tag "Automatically, `all' or since `repeat'" auto)))
+(defcustom org-task-overrun-text nil
+ "The extra modeline text that should indicate that the clock is overrun.
+The can be nil to indicate that instead of adding text, the clock time
+should get a different face (`org-mode-line-clock-overrun').
+When this is a string, it is prepended to the clock string as an indication,
+also using the face `org-mode-line-clock-overrun'."
+ :group 'org-clock
+ :type '(choice
+ (const :tag "Just mark the time string" nil)
+ (string :tag "Text to prepend")))
+
(defcustom org-show-notification-handler nil
"Function or program to send notification with.
The function or program will be called with the notification
(string :tag "Program")
(function :tag "Function")))
-(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file)
- "Default properties for new clocktables."
+(defgroup org-clocktable nil
+ "Options concerning the clock table in Org-mode."
+ :tag "Org Clock Table"
+ :group 'org-clock)
+
+(defcustom org-clocktable-defaults
+ (list
+ :maxlevel 2
+ :scope 'file
+ :block nil
+ :tstart nil
+ :tend nil
+ :step nil
+ :stepskip0 nil
+ :fileskip0 nil
+ :tags nil
+ :emphasize nil
+ :link nil
+ :narrow '40!
+ :indent t
+ :formula nil
+ :timestamp nil
+ :level nil
+ :tcolumns nil
+ :formatter nil)
+ "Default properties for clock tables."
:group 'org-clock
:type 'plist)
+(defcustom org-clock-clocktable-formatter 'org-clocktable-write-default
+ "Function to turn clocking data into a table.
+For more information, see `org-clocktable-write-default'."
+ :group 'org-clocktable
+ :type 'function)
+
+(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file)
+ "Default properties for new clocktables.
+These will be inserted into the BEGIN line, to make it easy for users to
+play with them."
+ :group 'org-clocktable
+ :type 'plist)
+
+(defcustom org-clock-idle-time nil
+ "When non-nil, resolve open clocks if the user is idle more than X minutes."
+ :group 'org-clock
+ :type '(choice
+ (const :tag "Never" nil)
+ (integer :tag "After N minutes")))
+
+(defcustom org-clock-auto-clock-resolution 'when-no-clock-is-running
+ "When to automatically resolve open clocks found in Org buffers."
+ :group 'org-clock
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "When no clock is running" when-no-clock-is-running)))
+
+(defcustom org-clock-report-include-clocking-task nil
+ "When non-nil, include the current clocking task time in clock reports."
+ :group 'org-clock
+ :type 'boolean)
+
+(defcustom org-clock-resolve-expert nil
+ "Non-nil means do not show the splash buffer with the clock resolver."
+ :group 'org-clock
+ :type 'boolean)
(defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock.
"Hook run when cancelling 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
+ "Has the clock been used during the current Emacs session?")
;;; The clock for measuring work time.
(put 'org-mode-line-string 'risky-local-variable t)
(defvar org-clock-mode-line-timer nil)
-(defvar org-clock-heading "")
+(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.")
+
(defvar org-clock-effort ""
- "Effort estimate of the currently clocking task")
+ "Effort estimate of the currently clocking task.")
(defvar org-clock-total-time nil
"Holds total time, spent previously on currently clocked item.
(defun org-clock-history-push (&optional pos buffer)
"Push a marker to the clock history."
(setq org-clock-history-length (max 1 (min 35 org-clock-history-length)))
- (let ((m (move-marker (make-marker) (or pos (point)) buffer)) n l)
+ (let ((m (move-marker (make-marker)
+ (or pos (point)) (org-base-buffer
+ (or buffer (current-buffer)))))
+ n l)
(while (setq n (member m org-clock-history))
(move-marker (car n) nil))
(setq org-clock-history
(mapc (lambda (m) (org-check-and-save-marker m beg end))
org-clock-history))
+(defun org-clocking-buffer ()
+ "Return the clocking buffer if we are currently clocking a task or nil."
+ (marker-buffer org-clock-marker))
+
+(defun org-clocking-p ()
+ "Return t when clocking a task."
+ (not (equal (org-clocking-buffer) nil)))
+
(defun org-clock-select-task (&optional prompt)
"Select a task that recently was associated with clocking."
(interactive)
(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 (marker-buffer org-clock-marker)
+ (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))
(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)
(org-fit-window-to-buffer)
(save-excursion
(save-restriction
(widen)
- (goto-char marker)
- (setq file (buffer-file-name (marker-buffer marker))
- cat (or (org-get-category)
- (progn (org-refresh-category-properties)
- (org-get-category)))
- heading (org-get-heading 'notags)
- prefix (save-excursion
- (org-back-to-heading t)
- (looking-at "\\*+ ")
- (match-string 0))
- task (substring
- (org-fontify-like-in-org-mode
- (concat prefix heading)
- org-odd-levels-only)
- (length prefix))))))
+ (ignore-errors
+ (goto-char marker)
+ (setq file (buffer-file-name (marker-buffer marker))
+ cat (or (org-get-category)
+ (progn (org-refresh-category-properties)
+ (org-get-category)))
+ heading (org-get-heading 'notags)
+ prefix (save-excursion
+ (org-back-to-heading t)
+ (looking-at "\\*+ ")
+ (match-string 0))
+ task (substring
+ (org-fontify-like-in-org-mode
+ (concat prefix heading)
+ org-odd-levels-only)
+ (length prefix)))))))
(when (and cat task)
(insert (format "[%c] %-15s %s\n" i cat task))
(cons i marker)))))
+(defvar org-task-overrun nil
+ "Internal flag indicating if the clock has overrun the planned time.")
+(defvar org-clock-update-period 60
+ "Number of seconds between mode line clock string updates.")
+
(defun org-clock-get-clock-string ()
- "Form a clock-string, that will be show in the mode line.
-If an effort estimate was defined for current item, use
+ "Form a clock-string, that will be shown in the mode line.
+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))))
- (if (and org-clock-effort)
- (let* ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort))
+ (if org-clock-effort
+ (let* ((effort-in-minutes
+ (org-hh:mm-string-to-minutes org-clock-effort))
(effort-h (floor effort-in-minutes 60))
- (effort-m (- effort-in-minutes (* effort-h 60))))
- (format (concat "-[" org-time-clocksum-format "/" org-time-clocksum-format " (%s)]")
- h m effort-h effort-m org-clock-heading))
- (format (concat "-[" org-time-clocksum-format " (%s)]")
- h m org-clock-heading))))
+ (effort-m (- effort-in-minutes (* effort-h 60)))
+ (work-done-str
+ (org-propertize
+ (format org-time-clocksum-format h m)
+ 'face (if (and org-task-overrun (not org-task-overrun-text))
+ 'org-mode-line-clock-overrun 'org-mode-line-clock)))
+ (effort-str (format org-time-clocksum-format effort-h effort-m))
+ (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)
+ 'face 'org-mode-line-clock))))
(defun org-clock-update-mode-line ()
+ (if org-clock-effort
+ (org-clock-notify-once-if-expired)
+ (setq org-task-overrun nil))
(setq org-mode-line-string
(org-propertize
(let ((clock-string (org-clock-get-clock-string))
(help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task"))
(if (and (> org-clock-string-limit 0)
(> (length clock-string) org-clock-string-limit))
- (org-propertize (substring clock-string 0 org-clock-string-limit)
- 'help-echo (concat help-text ": " org-clock-heading))
+ (org-propertize
+ (substring clock-string 0 org-clock-string-limit)
+ 'help-echo (concat help-text ": " org-clock-heading))
(org-propertize clock-string 'help-echo help-text)))
'local-map org-clock-mode-line-map
'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)
- 'face 'org-mode-line-clock))
- (if org-clock-effort (org-clock-notify-once-if-expired))
+ ))
+ (if (and org-task-overrun org-task-overrun-text)
+ (setq org-mode-line-string
+ (concat (org-propertize
+ org-task-overrun-text
+ 'face 'org-mode-line-clock-overrun) org-mode-line-string)))
(force-mode-line-update))
(defun org-clock-get-clocked-time ()
(defun org-clock-modify-effort-estimate (&optional value)
"Add to or set the effort estimate of the item currently being clocked.
-VALUE can be a number of minutes, or a string with forat hh:mm or mm.
-WHen the strig starts with a + or a - sign, the current value of the effort
+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."
;; A string. See if it is a delta
(setq sign (string-to-char value))
(if (member sign '(?- ?+))
- (setq current (org-hh:mm-string-to-minutes (substring current 1)))
+ (setq current (org-hh:mm-string-to-minutes current)
+ value (substring value 1))
(setq current 0))
(setq value (org-hh:mm-string-to-minutes value))
(if (equal ?- sign)
(defun org-clock-notify-once-if-expired ()
"Show notification if we spent more time than we estimated before.
Notification is shown only once."
- (when (marker-buffer org-clock-marker)
+ (when (org-clocking-p)
(let ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort))
(clocked-time (org-clock-get-clocked-time)))
- (if (>= clocked-time effort-in-minutes)
+ (if (setq org-task-overrun
+ (if (or (null effort-in-minutes) (zerop effort-in-minutes))
+ nil
+ (>= clocked-time effort-in-minutes)))
(unless org-clock-notification-was-shown
(setq org-clock-notification-was-shown t)
(org-notify
((stringp org-show-notification-handler)
(start-process "emacs-timer-notification" nil
org-show-notification-handler notification))
+ ((featurep 'notifications)
+ (require 'notifications)
+ (notifications-notify
+ :title "Org-mode message"
+ :body notification
+ ;; FIXME how to link to the Org icon?
+ ;; :app-icon "~/.emacs.d/icons/mail.png"
+ :urgency 'low))
((org-program-exists "notify-send")
(start-process "emacs-timer-notification" nil
"notify-send" notification))
;; Maybe the handler will send a message, so only use message as
;; a fall back option
- (t (message notification))))
+ (t (message "%s" notification))))
(defun org-clock-play-sound ()
"Play sound as configured by `org-clock-sound'.
((not org-clock-sound))
((eq org-clock-sound t) (beep t) (beep t))
((stringp org-clock-sound)
- (if (file-exists-p org-clock-sound)
- (if (org-program-exists "aplay")
- (start-process "org-clock-play-notification" nil
- "aplay" org-clock-sound)
- (condition-case nil
- (play-sound-file org-clock-sound)
- (error (beep t) (beep t))))))))
+ (let ((file (expand-file-name org-clock-sound)))
+ (if (file-exists-p file)
+ (if (org-program-exists "aplay")
+ (start-process "org-clock-play-notification" nil
+ "aplay" file)
+ (condition-case nil
+ (play-sound-file file)
+ (error (beep t) (beep t)))))))))
(defun org-program-exists (program-name)
"Checks whenever we can locate program and launch it."
(defvar org-clock-mode-line-entry nil
"Information for the modeline about the running clock.")
-(defun org-clock-in (&optional select)
+(defun org-find-open-clocks (file)
+ "Search through the given file and find all open clocks."
+ (let ((buf (or (get-file-buffer file)
+ (find-file-noselect file)))
+ clocks)
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t)
+ (push (cons (copy-marker (match-end 1) t)
+ (org-time-string-to-time (match-string 1))) clocks))))
+ clocks))
+
+(defsubst org-is-active-clock (clock)
+ "Return t if CLOCK is the currently active clock."
+ (and (org-clock-is-active)
+ (= org-clock-marker (car clock))))
+
+(defmacro org-with-clock-position (clock &rest forms)
+ "Evaluate FORMS with CLOCK as the current active clock."
+ `(with-current-buffer (marker-buffer (car ,clock))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (car ,clock))
+ (beginning-of-line)
+ ,@forms))))
+
+(put 'org-with-clock-position 'lisp-indent-function 1)
+
+(defmacro org-with-clock (clock &rest forms)
+ "Evaluate FORMS with CLOCK as the current active clock.
+This macro also protects the current active clock from being altered."
+ `(org-with-clock-position ,clock
+ (let ((org-clock-start-time (cdr ,clock))
+ (org-clock-total-time)
+ (org-clock-history)
+ (org-clock-effort)
+ (org-clock-marker (car ,clock))
+ (org-clock-hd-marker (save-excursion
+ (outline-back-to-heading t)
+ (point-marker))))
+ ,@forms)))
+
+(put 'org-with-clock 'lisp-indent-function 1)
+
+(defsubst org-clock-clock-in (clock &optional resume start-time)
+ "Clock in to the clock located by CLOCK.
+If necessary, clock-out of the currently active clock."
+ (org-with-clock-position clock
+ (let ((org-clock-in-resume (or resume org-clock-in-resume)))
+ (org-clock-in nil start-time))))
+
+(defsubst org-clock-clock-out (clock &optional fail-quietly at-time)
+ "Clock out of the clock located by CLOCK."
+ (let ((temp (copy-marker (car clock)
+ (marker-insertion-type (car clock)))))
+ (if (org-is-active-clock clock)
+ (org-clock-out fail-quietly at-time)
+ (org-with-clock clock
+ (org-clock-out fail-quietly at-time)))
+ (setcar clock temp)))
+
+(defsubst org-clock-clock-cancel (clock)
+ "Cancel the clock located by CLOCK."
+ (let ((temp (copy-marker (car clock)
+ (marker-insertion-type (car clock)))))
+ (if (org-is-active-clock clock)
+ (org-clock-cancel)
+ (org-with-clock clock
+ (org-clock-cancel)))
+ (setcar clock temp)))
+
+(defvar org-clock-clocking-in nil)
+(defvar org-clock-resolving-clocks nil)
+(defvar org-clock-resolving-clocks-due-to-idleness nil)
+
+(defun org-clock-resolve-clock (clock resolve-to clock-out-time
+ &optional close-p restart-p fail-quietly)
+ "Resolve `CLOCK' given the time `RESOLVE-TO', and the present.
+`CLOCK' is a cons cell of the form (MARKER START-TIME)."
+ (let ((org-clock-resolving-clocks t))
+ (cond
+ ((null resolve-to)
+ (org-clock-clock-cancel clock)
+ (if (and restart-p (not org-clock-clocking-in))
+ (org-clock-clock-in clock)))
+
+ ((eq resolve-to 'now)
+ (if restart-p
+ (error "RESTART-P is not valid here"))
+ (if (or close-p org-clock-clocking-in)
+ (org-clock-clock-out clock fail-quietly)
+ (unless (org-is-active-clock clock)
+ (org-clock-clock-in clock t))))
+
+ ((not (time-less-p resolve-to (current-time)))
+ (error "RESOLVE-TO must refer to a time in the past"))
+
+ (t
+ (if restart-p
+ (error "RESTART-P is not valid here"))
+ (org-clock-clock-out clock fail-quietly (or clock-out-time
+ resolve-to))
+ (unless org-clock-clocking-in
+ (if close-p
+ (setq org-clock-leftover-time (and (null clock-out-time)
+ resolve-to))
+ (org-clock-clock-in clock nil (and clock-out-time
+ resolve-to))))))))
+
+(defun org-clock-jump-to-current-clock (&optional effective-clock)
+ (interactive)
+ (let ((clock (or effective-clock (cons org-clock-marker
+ org-clock-start-time))))
+ (unless (marker-buffer (car clock))
+ (error "No clock is currently running"))
+ (org-with-clock clock (org-clock-goto))
+ (with-current-buffer (marker-buffer (car clock))
+ (goto-char (car clock))
+ (if org-clock-into-drawer
+ (let ((logbook
+ (if (stringp org-clock-into-drawer)
+ (concat ":" org-clock-into-drawer ":")
+ ":LOGBOOK:")))
+ (ignore-errors
+ (outline-flag-region
+ (save-excursion
+ (outline-back-to-heading t)
+ (search-forward logbook)
+ (goto-char (match-beginning 0)))
+ (save-excursion
+ (outline-back-to-heading t)
+ (search-forward logbook)
+ (search-forward ":END:")
+ (goto-char (match-end 0)))
+ nil)))))))
+
+(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
+ "Resolve an open org-mode clock.
+An open clock was found, with `dangling' possibly being non-nil.
+If this function was invoked with a prefix argument, non-dangling
+open clocks are ignored. The given clock requires some sort of
+user intervention to resolve it, either because a clock was left
+dangling or due to an idle timeout. The clock resolution can
+either be:
+
+ (a) deleted, the user doesn't care about the clock
+ (b) restarted from the current time (if no other clock is open)
+ (c) closed, giving the clock X minutes
+ (d) closed and then restarted
+ (e) resumed, as if the user had never left
+
+The format of clock is (CONS MARKER START-TIME), where MARKER
+identifies the buffer and position the clock is open at (and
+thus, the heading it's under), and START-TIME is when the clock
+was started."
+ (assert clock)
+ (let* ((ch
+ (save-window-excursion
+ (save-excursion
+ (unless org-clock-resolving-clocks-due-to-idleness
+ (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:
+
+i/q/C-g 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
+ 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.")))
+ (org-fit-window-to-buffer (get-buffer-window "*Org Clock*"))
+ (let (char-pressed)
+ (when (featurep 'xemacs)
+ (message (concat (funcall prompt-fn clock)
+ " [jkKgGsScCiq]? "))
+ (setq char-pressed (read-char-exclusive)))
+ (while (or (null char-pressed)
+ (and (not (memq char-pressed
+ '(?k ?K ?g ?G ?s ?S ?C
+ ?j ?J ?i ?q)))
+ (or (ding) t)))
+ (setq char-pressed
+ (read-char (concat (funcall prompt-fn clock)
+ " [jkKgGSscCiq]? ")
+ nil 45)))
+ (and (not (memq char-pressed '(?i ?q))) char-pressed)))))
+ (default
+ (floor (/ (org-float-time
+ (time-subtract (current-time) last-valid)) 60)))
+ (keep
+ (and (memq ch '(?k ?K))
+ (read-number "Keep how many minutes? " default)))
+ (gotback
+ (and (memq ch '(?g ?G))
+ (read-number "Got back how many minutes ago? " default)))
+ (subtractp (memq ch '(?s ?S)))
+ (barely-started-p (< (- (org-float-time last-valid)
+ (org-float-time (cdr clock))) 45))
+ (start-over (and subtractp barely-started-p)))
+ (cond
+ ((memq ch '(?j ?J))
+ (if (eq ch ?J)
+ (org-clock-resolve-clock clock 'now nil t nil fail-quietly))
+ (org-clock-jump-to-current-clock clock))
+ ((or (null ch)
+ (not (memq ch '(?k ?K ?g ?G ?s ?S ?C))))
+ (message ""))
+ (t
+ (org-clock-resolve-clock
+ clock (cond
+ ((or (eq ch ?C)
+ ;; If the time on the clock was less than a minute before
+ ;; the user went away, and they've ask to subtract all the
+ ;; time...
+ start-over)
+ nil)
+ ((or subtractp
+ (and gotback (= gotback 0)))
+ last-valid)
+ ((or (and keep (= keep default))
+ (and gotback (= gotback default)))
+ 'now)
+ (keep
+ (time-add last-valid (seconds-to-time (* 60 keep))))
+ (gotback
+ (time-subtract (current-time)
+ (seconds-to-time (* 60 gotback))))
+ (t
+ (error "Unexpected, please report this as a bug")))
+ (and gotback last-valid)
+ (memq ch '(?K ?G ?S))
+ (and start-over
+ (not (memq ch '(?K ?G ?S ?C))))
+ fail-quietly)))))
+
+(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid)
+ "Resolve all currently open org-mode clocks.
+If `only-dangling-p' is non-nil, only ask to resolve dangling
+\(i.e., not currently open and valid) clocks."
+ (interactive "P")
+ (unless org-clock-resolving-clocks
+ (let ((org-clock-resolving-clocks t))
+ (dolist (file (org-files-list))
+ (let ((clocks (org-find-open-clocks file)))
+ (dolist (clock clocks)
+ (let ((dangling (or (not (org-clock-is-active))
+ (/= (car clock) org-clock-marker))))
+ (if (or (not only-dangling-p) dangling)
+ (org-clock-resolve
+ clock
+ (or prompt-fn
+ (function
+ (lambda (clock)
+ (format
+ "Dangling clock started %d mins ago"
+ (floor
+ (/ (- (org-float-time (current-time))
+ (org-float-time (cdr clock))) 60))))))
+ (or last-valid
+ (cdr clock)))))))))))
+
+(defun org-emacs-idle-seconds ()
+ "Return the current Emacs idle time in seconds, or nil if not idle."
+ (let ((idle-time (current-idle-time)))
+ (if idle-time
+ (org-float-time idle-time)
+ 0)))
+
+(defun org-mac-idle-seconds ()
+ "Return the current Mac idle time in seconds."
+ (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'")))
+
+(defun org-x11-idle-seconds ()
+ "Return the current X11 idle time in seconds."
+ (/ (string-to-number (shell-command-to-string "x11idle")) 1000))
+
+(defun org-user-idle-seconds ()
+ "Return the number of seconds the user has been idle for.
+This routine returns a floating point number."
+ (cond
+ ((eq system-type 'darwin)
+ (org-mac-idle-seconds))
+ ((eq window-system 'x)
+ (org-x11-idle-seconds))
+ (t
+ (org-emacs-idle-seconds))))
+
+(defvar org-clock-user-idle-seconds)
+
+(defun org-resolve-clocks-if-idle ()
+ "Resolve all currently open org-mode clocks.
+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)
+ (let* ((org-clock-user-idle-seconds (org-user-idle-seconds))
+ (org-clock-user-idle-start
+ (time-subtract (current-time)
+ (seconds-to-time org-clock-user-idle-seconds)))
+ (org-clock-resolving-clocks-due-to-idleness t))
+ (if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))
+ (org-clock-resolve
+ (cons org-clock-marker
+ org-clock-start-time)
+ (function
+ (lambda (clock)
+ (format "Clocked in & idle for %.1f mins"
+ (/ (org-float-time
+ (time-subtract (current-time)
+ org-clock-user-idle-start))
+ 60.0))))
+ org-clock-user-idle-start)))))
+
+(defun org-clock-in (&optional select start-time)
"Start the clock on the current item.
If necessary, clock-out of the currently active clock.
-With prefix arg SELECT, offer a list of recently clocked tasks to
-clock into. When SELECT is `C-u C-u', clock into the current task and mark
+With a prefix argument SELECT (\\[universal-argument]), offer a list of \
+recently clocked tasks to
+clock into. When SELECT is \\[universal-argument] \\[universal-argument], \
+clock into the current task and mark
is as the default task, a special task that will always be offered in
the clocking selection, associated with the letter `d'."
(interactive "P")
(setq org-clock-notification-was-shown nil)
(catch 'abort
- (let ((interrupting (marker-buffer org-clock-marker))
- ts selected-task target-pos (msg-extra ""))
+ (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
+ (org-clocking-p)))
+ ts selected-task target-pos (msg-extra "")
+ (leftover (and (not org-clock-resolving-clocks)
+ org-clock-leftover-time)))
+ (when (and org-clock-auto-clock-resolution
+ (or (not interrupting)
+ (eq t org-clock-auto-clock-resolution))
+ (not org-clock-clocking-in)
+ (not org-clock-resolving-clocks))
+ (setq org-clock-leftover-time nil)
+ (let ((org-clock-clocking-in t))
+ (org-resolve-clocks))) ; check if any clocks are dangling
(when (equal select '(4))
(setq selected-task (org-clock-select-task "Clock-in on task: "))
(if selected-task
(when interrupting
;; We are interrupting the clocking of a different task.
;; Save a marker to this task, so that we can go back.
+ ;; First check if we are trying to clock into the same task!
+ (when (save-excursion
+ (unless selected-task
+ (org-back-to-heading t))
+ (and (equal (marker-buffer org-clock-hd-marker)
+ (if selected-task
+ (marker-buffer selected-task)
+ (current-buffer)))
+ (= (marker-position org-clock-hd-marker)
+ (if selected-task
+ (marker-position selected-task)
+ (point)))))
+ (message "Clock continues in \"%s\"" org-clock-heading)
+ (throw 'abort nil))
(move-marker org-clock-interrupted-task
(marker-position org-clock-marker)
(marker-buffer org-clock-marker))
- (org-clock-out t))
+ (let ((org-clock-clocking-in t))
+ (org-clock-out t)))
(when (equal select '(16))
;; Mark as default clocking task
(org-clock-mark-default-task))
- (setq target-pos (point)) ;; we want to clock in at this location
+ ;; Clock in at which position?
+ (setq target-pos
+ (if (and (eobp) (not (org-on-heading-p)))
+ (point-at-bol 0)
+ (point)))
(run-hooks 'org-clock-in-prepare-hook)
(save-excursion
(when (and selected-task (marker-buffer selected-task))
(org-back-to-heading t)
(or interrupting (move-marker org-clock-interrupted-task nil))
(org-clock-history-push)
+ (org-clock-set-current)
(cond ((functionp org-clock-in-switch-to-state)
(looking-at org-complex-heading-regexp)
(let ((newstate (funcall org-clock-in-switch-to-state
(functionp org-clock-heading-function))
(funcall org-clock-heading-function))
((looking-at org-complex-heading-regexp)
- (match-string 4))
+ (replace-regexp-in-string
+ "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1"
+ (match-string 4)))
(t "???")))
(setq org-clock-heading (org-propertize org-clock-heading
'face nil))
(setq org-clock-effort (org-get-effort))
(setq org-clock-total-time (org-clock-sum-current-item
(org-clock-get-sum-start)))
- (setq org-clock-start-time (current-time))
+ (setq org-clock-start-time
+ (or (and leftover
+ (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 leftover)) 60)))
+ leftover)
+ start-time
+ (current-time)))
(setq ts (org-insert-time-stamp org-clock-start-time
'with-hm 'inactive))))
(move-marker org-clock-marker (point) (buffer-base-buffer))
(move-marker org-clock-hd-marker
(save-excursion (org-back-to-heading t) (point))
(buffer-base-buffer))
+ (setq org-clock-has-been-used t)
(or global-mode-string (setq global-mode-string '("")))
(or (memq 'org-mode-line-string global-mode-string)
(setq global-mode-string
(append global-mode-string '(org-mode-line-string))))
(org-clock-update-mode-line)
+ (when org-clock-mode-line-timer
+ (cancel-timer org-clock-mode-line-timer)
+ (setq org-clock-mode-line-timer nil))
(setq org-clock-mode-line-timer
- (run-with-timer 60 60 'org-clock-update-mode-line))
+ (run-with-timer org-clock-update-period
+ org-clock-update-period
+ 'org-clock-update-mode-line))
+ (when org-clock-idle-timer
+ (cancel-timer org-clock-idle-timer)
+ (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)
(run-hooks 'org-clock-in-hook)))))))
+(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))
+
(defun org-clock-mark-default-task ()
"Mark current task as default task."
(interactive)
(and (re-search-forward org-property-end-re nil t)
(goto-char (match-beginning 0))))))))
-(defun org-clock-out (&optional fail-quietly)
+(defun org-clock-out (&optional fail-quietly at-time)
"Stop the currently running clock.
If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(interactive)
(catch 'exit
- (if (not (marker-buffer org-clock-marker))
- (if fail-quietly (throw 'exit t) (error "No active clock")))
+ (when (not (org-clocking-p))
+ (setq global-mode-string
+ (delq 'org-mode-line-string global-mode-string))
+ (force-mode-line-update)
+ (if fail-quietly (throw 'exit t) (error "No active clock")))
(let (ts te s h m remove)
- (save-excursion
- (set-buffer (marker-buffer org-clock-marker))
+ (save-excursion ; Do not replace this with `with-current-buffer'.
+ (with-no-warnings (set-buffer (org-clocking-buffer)))
(save-restriction
(widen)
(goto-char org-clock-marker)
(goto-char (match-end 0))
(delete-region (point) (point-at-eol))
(insert "--")
- (setq te (org-insert-time-stamp (current-time) 'with-hm 'inactive))
+ (setq te (org-insert-time-stamp (or at-time (current-time))
+ 'with-hm 'inactive))
(setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te)))
(org-float-time (apply 'encode-time (org-parse-time-string ts))))
h (floor (/ s 3600))
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
(setq org-clock-mode-line-timer nil))
+ (when org-clock-idle-timer
+ (cancel-timer org-clock-idle-timer)
+ (setq org-clock-idle-timer nil))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(when org-clock-out-switch-to-state
(save-excursion
(org-back-to-heading t)
- (let ((org-inhibit-logging t))
+ (let ((org-inhibit-logging t)
+ (org-clock-out-when-done nil))
(cond
((functionp org-clock-out-switch-to-state)
(looking-at org-complex-heading-regexp)
(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))))))
+ (run-hooks 'org-clock-out-hook)
+ (org-clock-delete-current))))))
(defun org-clock-cancel ()
- "Cancel the running clock be removing the start timestamp."
+ "Cancel the running clock by removing the start timestamp."
(interactive)
- (if (not (marker-buffer org-clock-marker))
- (error "No active clock"))
- (save-excursion
- (set-buffer (marker-buffer org-clock-marker))
+ (when (not (org-clocking-p))
+ (setq global-mode-string
+ (delq 'org-mode-line-string global-mode-string))
+ (force-mode-line-update)
+ (error "No active clock"))
+ (save-excursion ; Do not replace this with `with-current-buffer'.
+ (with-no-warnings (set-buffer (org-clocking-buffer)))
(goto-char org-clock-marker)
- (delete-region (1- (point-at-bol)) (point-at-eol)))
- (move-marker 'org-clock-marker nil)
- (move-marker 'org-clock-hd-marker nil)
+ (delete-region (1- (point-at-bol)) (point-at-eol))
+ ;; Just in case, remove any empty LOGBOOK left over
+ (org-remove-empty-drawer-at "LOGBOOK" (point)))
+ (move-marker org-clock-marker nil)
+ (move-marker org-clock-hd-marker nil)
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(force-mode-line-update)
(select
(or (org-clock-select-task "Select task to go to: ")
(error "No task selected")))
- ((marker-buffer org-clock-marker) org-clock-marker)
+ ((org-clocking-p) org-clock-marker)
((and org-clock-goto-may-find-recent-task
(car org-clock-history)
(marker-buffer (car org-clock-history)))
(org-back-to-heading t)
(org-cycle-hide-drawers 'children)
(recenter)
+ (org-reveal)
(if recent
(message "No running clock, this is the most recently clocked task"))
(run-hooks 'org-clock-goto-hook)))
"Holds the file total time in minutes, after a call to `org-clock-sum'.")
(make-variable-buffer-local 'org-clock-file-total-minutes)
-(defun org-clock-sum (&optional tstart tend)
+(defun org-clock-sum (&optional tstart tend headline-filter)
"Sum the times for each subtree.
Puts the resulting times in minutes as a text property on each headline.
-TSTART and TEND can mark a time range to be considered."
+TSTART and TEND can mark a time range to be considered. HEADLINE-FILTER is a
+zero-arg function that, if specified, is called for each headline in the time
+range with point at the headline. Headlines for which HEADLINE-FILTER returns
+nil are excluded from the clock summation."
(interactive)
(let* ((bmp (buffer-modified-p))
(re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
(if (stringp tend) (setq tend (org-time-string-to-seconds tend)))
(if (consp tstart) (setq tstart (org-float-time tstart)))
(if (consp tend) (setq tend (org-float-time tend)))
- (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t))
+ (remove-text-properties (point-min) (point-max)
+ '(:org-clock-minutes t
+ :org-clock-force-headline-inclusion t))
(save-excursion
(goto-char (point-max))
(while (re-search-backward re nil t)
(setq t1 (+ t1 (string-to-number (match-string 5))
(* 60 (string-to-number (match-string 4))))))
(t ;; A headline
- (setq level (- (match-end 1) (match-beginning 1)))
- (when (or (> t1 0) (> (aref ltimes level) 0))
- (loop for l from 0 to level do
- (aset ltimes l (+ (aref ltimes l) t1)))
- (setq t1 0 time (aref ltimes level))
- (loop for l from level to (1- lmax) do
- (aset ltimes l 0))
- (goto-char (match-beginning 0))
- (put-text-property (point) (point-at-eol) :org-clock-minutes time)))))
+ ;; Add the currently clocking item time to the total
+ (when (and org-clock-report-include-clocking-task
+ (equal (org-clocking-buffer) (current-buffer))
+ (equal (marker-position org-clock-hd-marker) (point))
+ tstart
+ tend
+ (>= (org-float-time org-clock-start-time) tstart)
+ (<= (org-float-time org-clock-start-time) tend))
+ (let ((time (floor (- (org-float-time)
+ (org-float-time org-clock-start-time)) 60)))
+ (setq t1 (+ t1 time))))
+ (let* ((headline-forced
+ (get-text-property (point)
+ :org-clock-force-headline-inclusion))
+ (headline-included
+ (or (null headline-filter)
+ (save-excursion
+ (save-match-data (funcall headline-filter))))))
+ (setq level (- (match-end 1) (match-beginning 1)))
+ (when (or (> t1 0) (> (aref ltimes level) 0))
+ (when (or headline-included headline-forced)
+ (if headline-included
+ (loop for l from 0 to level do
+ (aset ltimes l (+ (aref ltimes l) t1))))
+ (setq time (aref ltimes level))
+ (goto-char (match-beginning 0))
+ (put-text-property (point) (point-at-eol) :org-clock-minutes time)
+ (if headline-filter
+ (save-excursion
+ (save-match-data
+ (while
+ (> (funcall outline-level) 1)
+ (outline-up-heading 1 t)
+ (put-text-property
+ (point) (point-at-eol)
+ :org-clock-force-headline-inclusion t))))))
+ (setq t1 0)
+ (loop for l from level to (1- lmax) do
+ (aset ltimes l 0)))))))
(setq org-clock-file-total-minutes (aref ltimes 0)))
(set-buffer-modified-p bmp)))
(defun org-clock-sum-current-item (&optional tstart)
- "Returns time, clocked on current item in total"
+ "Return time, clocked on current item in total."
(save-excursion
(save-restriction
(org-narrow-to-subtree)
(when org-remove-highlights-with-change
(org-add-hook 'before-change-functions 'org-clock-remove-overlays
nil 'local))))
- (message (concat "Total file time: " org-time-clocksum-format " (%d hours and %d minutes)") h m h m)))
+ (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))))
(defvar org-clock-overlays nil)
(make-variable-buffer-local 'org-clock-overlays)
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 " org-time-clocksum-format "%s"))
+ (fmt (concat "%s " (if org-time-clocksum-use-fractional
+ org-time-clocksum-fractional-format
+ org-time-clocksum-format) "%s"))
(off 0)
ov tx)
(org-move-to-column c)
(unless (eolp) (skip-chars-backward "^ \t"))
(skip-chars-backward " \t")
- (setq ov (org-make-overlay (1- (point)) (point-at-eol))
+ (setq ov (make-overlay (1- (point)) (point-at-eol))
tx (concat (buffer-substring (1- (point)) (point))
(make-string (+ off (max 0 (- c (current-column)))) ?.)
- (org-add-props (format fmt
- (make-string l ?*) h m
- (make-string (- 16 l) ?\ ))
+ (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) ?\ )))
(list 'face 'org-clock-overlay))
""))
(if (not (featurep 'xemacs))
- (org-overlay-put ov 'display tx)
- (org-overlay-put ov 'invisible t)
- (org-overlay-put ov 'end-glyph (make-glyph tx)))
+ (overlay-put ov 'display tx)
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'end-glyph (make-glyph tx)))
(push ov org-clock-overlays)))
(defun org-clock-remove-overlays (&optional beg end noremove)
from the `before-change-functions' in the current buffer."
(interactive)
(unless org-inhibit-highlight-removal
- (mapc 'org-delete-overlay org-clock-overlays)
+ (mapc 'delete-overlay org-clock-overlays)
(setq org-clock-overlays nil)
(unless noremove
(remove-hook 'before-change-functions
This is used to stop the clock after a TODO entry is marked DONE,
and is only done if the variable `org-clock-out-when-done' is not nil."
(when (and org-clock-out-when-done
- (member state org-done-keywords)
- (equal (or (buffer-base-buffer (marker-buffer org-clock-marker))
- (marker-buffer org-clock-marker))
+ (or (and (eq t org-clock-out-when-done)
+ (member state org-done-keywords))
+ (and (listp org-clock-out-when-done)
+ (member state org-clock-out-when-done)))
+ (equal (or (buffer-base-buffer (org-clocking-buffer))
+ (org-clocking-buffer))
(or (buffer-base-buffer (current-buffer))
(current-buffer)))
(< (point) org-clock-marker)
(> (save-excursion (outline-next-heading) (point))
org-clock-marker))
;; Clock out, but don't accept a logging message for this.
- (let ((org-log-note-clock-out nil))
+ (let ((org-log-note-clock-out nil)
+ (org-clock-out-switch-to-state nil))
(org-clock-out))))
(add-hook 'org-after-todo-state-change-hook
(font-lock-fontify-buffer)
(forward-line 2)
(buffer-substring (point) (progn
- (re-search-forward "^#\\+END" nil t)
+ (re-search-forward "^[ \t]*#\\+END" nil t)
(point-at-bol)))))
(defun org-clock-report (&optional arg)
(let ((pos (point)) start)
(save-excursion
(end-of-line 1)
- (and (re-search-backward "^#\\+BEGIN:[ \t]+clocktable" nil t)
+ (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t)
(setq start (match-beginning 0))
- (re-search-forward "^#\\+END:.*" nil t)
+ (re-search-forward "^[ \t]*#\\+END:.*" nil t)
(>= (match-end 0) pos)
start))))
+(defun org-day-of-week (day month year)
+ "Returns the day of the week as an integer."
+ (nth 6
+ (decode-time
+ (date-to-time
+ (format "%d-%02d-%02dT00:00:00" year month day)))))
+
+(defun org-quarter-to-date (quarter year)
+ "Get the date (week day year) of the first day of a given quarter."
+ (let (startday)
+ (cond
+ ((= quarter 1)
+ (setq startday (org-day-of-week 1 1 year))
+ (cond
+ ((= startday 0)
+ (list 52 7 (- year 1)))
+ ((= startday 6)
+ (list 52 6 (- year 1)))
+ ((<= startday 4)
+ (list 1 startday year))
+ ((> startday 4)
+ (list 53 startday (- year 1)))
+ )
+ )
+ ((= quarter 2)
+ (setq startday (org-day-of-week 1 4 year))
+ (cond
+ ((= startday 0)
+ (list 13 startday year))
+ ((< startday 4)
+ (list 14 startday year))
+ ((>= startday 4)
+ (list 13 startday year))
+ )
+ )
+ ((= quarter 3)
+ (setq startday (org-day-of-week 1 7 year))
+ (cond
+ ((= startday 0)
+ (list 26 startday year))
+ ((< startday 4)
+ (list 27 startday year))
+ ((>= startday 4)
+ (list 26 startday year))
+ )
+ )
+ ((= quarter 4)
+ (setq startday (org-day-of-week 1 10 year))
+ (cond
+ ((= startday 0)
+ (list 39 startday year))
+ ((<= startday 4)
+ (list 40 startday year))
+ ((> startday 4)
+ (list 39 startday year)))))))
+
(defun org-clock-special-range (key &optional time as-strings)
"Return two times bordering a special time range.
Key is a symbol specifying the range and can be one of `today', `yesterday',
(dow (nth 6 tm))
(skey (symbol-name key))
(shift 0)
- s1 m1 h1 d1 month1 y1 diff ts te fm txt w date)
+ (q (cond ((>= (nth 4 tm) 10) 4)
+ ((>= (nth 4 tm) 7) 3)
+ ((>= (nth 4 tm) 4) 2)
+ ((>= (nth 4 tm) 1) 1)))
+ s1 m1 h1 d1 month1 y1 diff ts te fm txt w date
+ interval tmp shiftedy shiftedm shiftedq)
(cond
((string-match "^[0-9]+$" skey)
(setq y (string-to-number skey) m 1 d 1 key 'year))
(setq d (nth 1 date) month (car date) y (nth 2 date)
dow 1
key 'week))
+ ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
+ (require 'cal-iso)
+ (setq y (string-to-number (match-string 1 skey)))
+ (setq q (string-to-number (match-string 2 skey)))
+ (setq date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso (org-quarter-to-date q y))))
+ (setq d (nth 1 date) month (car date) y (nth 2 date)
+ dow 1
+ key 'quarter))
((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey)
(setq y (string-to-number (match-string 1 skey))
month (string-to-number (match-string 2 skey))
key 'day))
((string-match "\\([-+][0-9]+\\)$" skey)
(setq shift (string-to-number (match-string 1 skey))
- key (intern (substring skey 0 (match-beginning 1))))))
+ key (intern (substring skey 0 (match-beginning 1))))
+ (if(and (memq key '(quarter thisq)) (> shift 0))
+ (error "Looking forward with quarters isn't implemented.")
+ ())))
+
(when (= shift 0)
- (cond ((eq key 'yesterday) (setq key 'today shift -1))
- ((eq key 'lastweek) (setq key 'week shift -1))
- ((eq key 'lastmonth) (setq key 'month shift -1))
- ((eq key 'lastyear) (setq key 'year shift -1))))
+ (cond ((eq key 'yesterday) (setq key 'today shift -1))
+ ((eq key 'lastweek) (setq key 'week shift -1))
+ ((eq key 'lastmonth) (setq key 'month shift -1))
+ ((eq key 'lastyear) (setq key 'year shift -1))
+ ((eq key 'lastq) (setq key 'quarter shift -1))))
(cond
((memq key '(day today))
(setq d (+ d shift) h 0 m 0 h1 24 m1 0))
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))
+ ((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
+ (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))
+ (setq tmp (org-floor* interval 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
+ shiftedq 1)
+ (setq shiftedy (- y (+ 1 (nth 0 tmp)))
+ shiftedm (- 13 (* 3 (nth 1 tmp)))
+ shiftedq (- 5 (nth 1 tmp))))
+ (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy))
+ ((> (+ q shift) 0) ; shift is whitin this year
+ (setq shiftedq (+ q shift))
+ (setq shiftedy y)
+ (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
((memq key '(year thisyear))
(setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
(t (error "No such time block %s" key)))
((memq key '(month thismonth))
(setq txt (format-time-string "%B %Y" ts)))
((memq key '(year thisyear))
- (setq txt (format-time-string "the year %Y" ts))))
+ (setq txt (format-time-string "the year %Y" ts)))
+ ((memq key '(quarter thisq))
+ (setq txt (concatenate 'string (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))))
+(defun org-count-quarter (n)
+ (cond
+ ((= n 1) "1st")
+ ((= n 2) "2nd")
+ ((= n 3) "3rd")
+ ((= n 4) "4th")))
+
(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
(and (memq dir '(left down)) (setq n (- n)))
(save-excursion
(goto-char (point-at-bol))
- (if (not (looking-at "#\\+BEGIN: clocktable\\>.*?:block[ \t]+\\(\\S-+\\)"))
+ (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)"))
(error "Line needs a :block definition before this command works")
(let* ((b (match-beginning 1)) (e (match-end 1))
(s (match-string 1))
((equal s "yesterday") (setq s "today-1"))
((equal s "lastweek") (setq s "thisweek-1"))
((equal s "lastmonth") (setq s "thismonth-1"))
- ((equal s "lastyear") (setq s "thisyear-1")))
- (cond
- ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\)\\([-+][0-9]+\\)?$" s)
- (setq block (match-string 1 s)
- shift (if (match-end 2)
- (string-to-number (match-string 2 s))
- 0))
- (setq shift (+ shift n))
- (setq ins (if (= shift 0) block (format "%s%+d" block shift))))
- ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
- ;; 1 1 2 3 3 4 4 5 6 6 5 2
- (setq y (string-to-number (match-string 1 s))
- wp (and (match-end 3) (match-string 3 s))
- mw (and (match-end 4) (string-to-number (match-string 4 s)))
- d (and (match-end 6) (string-to-number (match-string 6 s))))
- (cond
- (d (setq ins (format-time-string
- "%Y-%m-%d"
- (encode-time 0 0 0 (+ d n) m y))))
- ((and wp mw (> (length wp) 0))
- (require 'cal-iso)
- (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y))))
- (setq ins (format-time-string
- "%G-W%V"
- (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
- (mw
- (setq ins (format-time-string
- "%Y-%m"
- (encode-time 0 0 0 1 (+ mw n) y))))
- (y
- (setq ins (number-to-string (+ y n))))))
- (t (error "Cannot shift clocktable block")))
- (when ins
- (goto-char b)
- (insert ins)
- (delete-region (point) (+ (point) (- e b)))
- (beginning-of-line 1)
- (org-update-dblock)
- t)))))
+ ((equal s "lastyear") (setq s "thisyear-1"))
+ ((equal s "lastq") (setq s "thisq-1")))
+
+ (cond
+ ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s)
+ (setq block (match-string 1 s)
+ shift (if (match-end 2)
+ (string-to-number (match-string 2 s))
+ 0))
+ (setq shift (+ shift n))
+ (setq ins (if (= shift 0) block (format "%s%+d" block shift))))
+ ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
+ ;; 1 1 2 3 3 4 4 5 6 6 5 2
+ (setq y (string-to-number (match-string 1 s))
+ wp (and (match-end 3) (match-string 3 s))
+ mw (and (match-end 4) (string-to-number (match-string 4 s)))
+ d (and (match-end 6) (string-to-number (match-string 6 s))))
+ (cond
+ (d (setq ins (format-time-string
+ "%Y-%m-%d"
+ (encode-time 0 0 0 (+ d n) m y))))
+ ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
+ (require 'cal-iso)
+ (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y))))
+ (setq ins (format-time-string
+ "%G-W%V"
+ (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
+ ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
+ (require 'cal-iso)
+ ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year
+ (if (> (+ mw n) 4)
+ (setq mw 0
+ y (+ 1 y))
+ ())
+ ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year
+ (if (= (+ mw n) 0)
+ (setq mw 5
+ y (- y 1))
+ ())
+ (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y))))
+ (setq ins (format-time-string
+ (concatenate 'string (number-to-string y) "-Q" (number-to-string (+ mw n)))
+ (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
+ (mw
+ (setq ins (format-time-string
+ "%Y-%m"
+ (encode-time 0 0 0 1 (+ mw n) y))))
+ (y
+ (setq ins (number-to-string (+ y n))))))
+ (t (error "Cannot shift clocktable block")))
+ (when ins
+ (goto-char b)
+ (insert ins)
+ (delete-region (point) (+ (point) (- e b)))
+ (beginning-of-line 1)
+ (org-update-dblock)
+ t)))))
(defun org-dblock-write:clocktable (params)
"Write the standard clocktable."
+ (setq params (org-combine-plists org-clocktable-defaults params))
(catch 'exit
- (let* ((hlchars '((1 . "*") (2 . "/")))
- (ins (make-marker))
- (total-time nil)
- (scope (plist-get params :scope))
- (tostring (plist-get params :tostring))
- (multifile (plist-get params :multifile))
- (header (plist-get params :header))
- (maxlevel (or (plist-get params :maxlevel) 3))
- (step (plist-get params :step))
- (emph (plist-get params :emphasize))
- (timestamp (plist-get params :timestamp))
+ (let* ((scope (plist-get params :scope))
+ (block (plist-get params :block))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
- (block (plist-get params :block))
(link (plist-get params :link))
- ipos time p level hlc hdl tsp props content recalc formula pcol
- cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list st)
- (setq org-clock-file-total-minutes nil)
+ (maxlevel (or (plist-get params :maxlevel) 3))
+ (step (plist-get params :step))
+ (timestamp (plist-get params :timestamp))
+ (formatter (or (plist-get params :formatter)
+ org-clock-clocktable-formatter
+ 'org-clocktable-write-default))
+ cc range-text ipos pos one-file-with-archives
+ scope-is-list tbls level)
+
+ ;; 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)
+ ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(when step
+ ;; Write many tables, in steps
(unless (or block (and ts te))
(error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'"))
(org-clocktable-steps params)
(throw 'exit nil))
- (when block
- (setq cc (org-clock-special-range block nil t)
- 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)))
- (when (and ts (listp ts))
- (setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts))))
- (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)))))
- (move-marker ins (point))
- (setq ipos (point))
+
+ (setq ipos (point)) ; remember the insertion position
;; Get the right scope
(setq pos (point))
(setq scope (org-add-archive-files scope)))
((eq scope 'file-with-archives)
(setq scope (org-add-archive-files (list (buffer-file-name)))
- rm-file-column t)))
+ one-file-with-archives t)))
(setq scope-is-list (and scope (listp scope)))
- (save-restriction
- (cond
- ((not scope))
- ((eq scope 'file) (widen))
- ((eq scope 'subtree) (org-narrow-to-subtree))
- ((eq scope 'tree)
- (while (org-up-heading-safe))
- (org-narrow-to-subtree))
- ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$"
- (symbol-name scope)))
- (setq level (string-to-number (match-string 1 (symbol-name scope))))
- (catch 'exit
- (while (org-up-heading-safe)
- (looking-at outline-regexp)
- (if (<= (org-reduced-level (funcall outline-level)) level)
- (throw 'exit nil))))
- (org-narrow-to-subtree))
- (scope-is-list
+ (if scope-is-list
+ ;; we collect from several files
(let* ((files scope)
- (scope 'agenda)
- (p1 (copy-sequence params))
file)
- (setq p1 (plist-put p1 :tostring t))
- (setq p1 (plist-put p1 :multifile t))
- (setq p1 (plist-put p1 :scope 'file))
(org-prepare-agenda-buffers files)
(while (setq file (pop files))
(with-current-buffer (find-buffer-visiting file)
- (setq tbl1 (org-dblock-write:clocktable p1))
- (when tbl1
- (push (org-clocktable-add-file
- file
- (concat "| |*File time*|*"
- (org-minutes-to-hh:mm-string
- org-clock-file-total-minutes)
- "*|\n"
- tbl1)) tbl)
- (setq total-time (+ (or total-time 0)
- org-clock-file-total-minutes))))))))
- (goto-char pos)
-
- (unless scope-is-list
- (org-clock-sum ts te)
- (goto-char (point-min))
- (setq st t)
- (while (or (and (bobp) (prog1 st (setq st nil))
- (get-text-property (point) :org-clock-minutes)
- (setq p (point-min)))
- (setq p (next-single-property-change (point) :org-clock-minutes)))
- (goto-char p)
- (when (setq time (get-text-property p :org-clock-minutes))
- (save-excursion
- (beginning-of-line 1)
- (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@:]+:\\)?[ \t]*$"))
- (setq level (org-reduced-level
- (- (match-end 1) (match-beginning 1))))
- (<= level maxlevel))
- (setq hlc (if emph (or (cdr (assoc level hlchars)) "") "")
- hdl (if (not link)
- (match-string 2)
- (org-make-link-string
- (format "file:%s::%s"
- (buffer-file-name)
- (save-match-data
- (org-make-org-heading-search-string
- (match-string 2))))
- (match-string 2)))
- tsp (when timestamp
- (setq props (org-entry-properties (point)))
- (or (cdr (assoc "SCHEDULED" props))
- (cdr (assoc "TIMESTAMP" props))
- (cdr (assoc "DEADLINE" props))
- (cdr (assoc "TIMESTAMP_IA" props)))))
- (if (and (not multifile) (= level 1)) (push "|-" tbl))
- (push (concat
- "| " (int-to-string level) "|"
- (if timestamp (concat tsp "|") "")
- hlc hdl hlc " |"
- (make-string (1- level) ?|)
- hlc (org-minutes-to-hh:mm-string time) hlc
- " |") tbl))))))
- (setq tbl (nreverse tbl))
- (if tostring
- (if tbl (mapconcat 'identity tbl "\n") nil)
- (goto-char ins)
- (insert-before-markers
- (or header
- (concat
- "Clock summary at ["
- (substring
- (format-time-string (cdr org-time-stamp-formats))
- 1 -1)
- "]"
- (if block (concat ", for " range-text ".") "")
- "\n\n"))
- (if scope-is-list "|File" "")
- "|L|" (if timestamp "Timestamp|" "") "Headline|Time|\n")
- (setq total-time (or total-time org-clock-file-total-minutes))
- (insert-before-markers
- "|-\n|"
- (if scope-is-list "|" "")
- (if timestamp "|Timestamp|" "|")
- "*Total time*| *"
- (org-minutes-to-hh:mm-string (or total-time 0))
- "*|\n|-\n")
- (setq tbl (delq nil tbl))
- (if (and (stringp (car tbl)) (> (length (car tbl)) 1)
- (equal (substring (car tbl) 0 2) "|-"))
- (pop tbl))
- (insert-before-markers (mapconcat
- 'identity (delq nil tbl)
- (if scope-is-list "\n|-\n" "\n")))
- (backward-delete-char 1)
- (if (setq formula (plist-get params :formula))
- (cond
- ((eq formula '%)
- (setq pcol (+ (if scope-is-list 1 0) maxlevel 3))
- (insert
- (format
- "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
- pcol
- 2
- (+ 3 (if scope-is-list 1 0))
- (+ (if scope-is-list 1 0) 3)
- (1- pcol)))
- (setq recalc t))
- ((stringp formula)
- (insert "\n#+TBLFM: " formula)
- (setq recalc t))
- (t (error "invalid formula in clocktable")))
- ;; Should we rescue an old formula?
- (when (stringp (setq content (plist-get params :content)))
- (when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content)
- (setq recalc t)
- (insert "\n" (match-string 1 (plist-get params :content)))
- (beginning-of-line 0))))
- (goto-char ipos)
- (skip-chars-forward "^|")
- (org-table-align)
- (when recalc
- (if (eq formula '%)
- (save-excursion (org-table-goto-column pcol nil 'force)
- (insert "%")))
- (org-table-recalculate 'all))
- (when rm-file-column
- (forward-char 1)
- (org-table-delete-column)))))))
+ (save-excursion
+ (save-restriction
+ (push (org-clock-get-table-data file params) tbls))))))
+ ;; Just from the current file
+ (save-restriction
+ ;; get the right range into the restriction
+ (org-prepare-agenda-buffers (list (buffer-file-name)))
+ (cond
+ ((not scope)) ; use the restriction as it is now
+ ((eq scope 'file) (widen))
+ ((eq scope 'subtree) (org-narrow-to-subtree))
+ ((eq scope 'tree)
+ (while (org-up-heading-safe))
+ (org-narrow-to-subtree))
+ ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$"
+ (symbol-name scope)))
+ (setq level (string-to-number (match-string 1 (symbol-name scope))))
+ (catch 'exit
+ (while (org-up-heading-safe)
+ (looking-at outline-regexp)
+ (if (<= (org-reduced-level (funcall outline-level)) level)
+ (throw 'exit nil))))
+ (org-narrow-to-subtree)))
+ ;; do the table, with no file name.
+ (push (org-clock-get-table-data nil params) tbls)))
+
+ ;; OK, at this point we tbls as a list of tables, one per file
+ (setq tbls (nreverse tbls))
+
+ (setq params (plist-put params :multifile scope-is-list))
+ (setq params (plist-put params :one-file-with-archives
+ one-file-with-archives))
+
+ (funcall formatter ipos tbls params))))
+
+(defun org-clocktable-write-default (ipos tables params)
+ "Write out a clock table at position IPOS in the current buffer.
+TABLES is a list of tables with clocking data as produced by
+`org-clock-get-table-data'. PARAMS is the parameter property list obtained
+from the dynamic block defintion."
+ ;; This function looks quite complicated, mainly because there are a lot
+ ;; of options which can add or remove columns. I have massively commented
+ ;; function, to I hope it is understandable. If someone want to write
+ ;; there own special formatter, this maybe much easier because there can
+ ;; be a fixed format with a well-defined number of columns...
+ (let* ((hlchars '((1 . "*") (2 . "/")))
+ (multifile (plist-get params :multifile))
+ (block (plist-get params :block))
+ (ts (plist-get params :tstart))
+ (te (plist-get params :tend))
+ (header (plist-get params :header))
+ (narrow (plist-get params :narrow))
+ (link (plist-get params :link))
+ (maxlevel (or (plist-get params :maxlevel) 3))
+ (emph (plist-get params :emphasize))
+ (level-p (plist-get params :level))
+ (timestamp (plist-get params :timestamp))
+ (ntcol (max 1 (or (plist-get params :tcolumns) 100)))
+ (rm-file-column (plist-get params :one-file-with-archives))
+ (indent (plist-get params :indent))
+ range-text total-time tbl level hlc formula pcol
+ file-time entries entry headline
+ recalc content narrow-cut-p tcol)
+
+ ;; Implement abbreviations
+ (when (plist-get params :compact)
+ (setq level nil indent t narrow (or narrow '40!) ntcol 1))
+
+ ;; Some consistency test for parameters
+ (unless (integerp ntcol)
+ (setq params (plist-put params :tcolumns (setq ntcol 100))))
+
+ (when (and narrow (integerp narrow) link)
+ ;; We cannot have both integer narrow and link
+ (message
+ "Using hard narrowing in clocktable to allow for links")
+ (setq narrow (intern (format "%d!" narrow))))
+
+ (when narrow
+ (cond
+ ((integerp narrow))
+ ((and (symbolp narrow)
+ (string-match "\\`[0-9]+!\\'" (symbol-name narrow)))
+ (setq narrow-cut-p t
+ narrow (string-to-number (substring (symbol-name narrow)
+ 0 -1))))
+ (t
+ (error "Invalid value %s of :narrow property in clock table"
+ narrow))))
+
+ (when block
+ ;; Get the range text for the header
+ (setq range-text (nth 2 (org-clock-special-range block nil t))))
+
+ ;; Compute the total time
+ (setq total-time (apply '+ (mapcar 'cadr tables)))
+
+ ;; Now we need to output this tsuff
+ (goto-char ipos)
+
+ ;; Insert the text *before* the actual table
+ (insert-before-markers
+ (or header
+ ;; Format the standard header
+ (concat
+ "Clock summary at ["
+ (substring
+ (format-time-string (cdr org-time-stamp-formats))
+ 1 -1)
+ "]"
+ (if block (concat ", for " range-text ".") "")
+ "\n\n")))
+
+ ;; Insert the narrowing line
+ (when (and narrow (integerp narrow) (not narrow-cut-p))
+ (insert-before-markers
+ "|" ; table line starter
+ (if multifile "|" "") ; file column, maybe
+ (if level-p "|" "") ; level column, maybe
+ (if timestamp "|" "") ; timestamp column, maybe
+ (format "<%d>| |\n" narrow))) ; headline and time columns
+
+ ;; Insert the table header line
+ (insert-before-markers
+ "|" ; table line starter
+ (if multifile "File|" "") ; file column, maybe
+ (if level-p "L|" "") ; level column, maybe
+ (if timestamp "Timestamp|" "") ; timestamp column, maybe
+ "Headline|Time|\n") ; headline and time columns
+
+ ;; Insert the total time in the table
+ (insert-before-markers
+ "|-\n" ; a hline
+ "|" ; table line starter
+ (if multifile "| ALL " "") ; file column, maybe
+ (if level-p "|" "") ; level column, maybe
+ (if timestamp "|" "") ; timestamp column, maybe
+ "*Total time*| " ; instead of a headline
+ "*"
+ (org-minutes-to-hh:mm-string (or total-time 0)) ; the time
+ "*|\n") ; close line
+
+ ;; Now iterate over the tables and insert the data
+ ;; but only if any time has been collected
+ (when (and total-time (> total-time 0))
+
+ (while (setq tbl (pop tables))
+ ;; now tbl is the table resulting from one file.
+ (setq file-time (nth 1 tbl))
+ (when (or (and file-time (> file-time 0))
+ (not (plist-get params :fileskip0)))
+ (insert-before-markers "|-\n") ; a hline because a new file starts
+ ;; First the file time, if we have multiple files
+ (when multifile
+ ;; Summarize the time colleted from this file
+ (insert-before-markers
+ (format "| %s %s | %s*File time* | *%s*|\n"
+ (file-name-nondirectory (car tbl))
+ (if level-p "| " "") ; level column, maybe
+ (if timestamp "| " "") ; timestamp column, maybe
+ (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time
+
+ ;; Get the list of node entries and iterate over it
+ (setq entries (nth 2 tbl))
+ (while (setq entry (pop entries))
+ (setq level (car entry)
+ headline (nth 1 entry)
+ hlc (if emph (or (cdr (assoc level hlchars)) "") ""))
+ (when narrow-cut-p
+ (if (and (string-match (concat "\\`" org-bracket-link-regexp
+ "\\'")
+ headline)
+ (match-end 3))
+ (setq headline
+ (format "[[%s][%s]]"
+ (match-string 1 headline)
+ (org-shorten-string (match-string 3 headline)
+ narrow)))
+ (setq headline (org-shorten-string headline narrow))))
+ (insert-before-markers
+ "|" ; start the table line
+ (if multifile "|" "") ; free space for file name column?
+ (if level-p (format "%d|" (car entry)) "") ; level, maybe
+ (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe
+ (if indent (org-clocktable-indent-string level) "") ; indentation
+ 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
+ "|\n" ; close line
+ )))))
+ (backward-delete-char 1)
+ (if (setq formula (plist-get params :formula))
+ (cond
+ ((eq formula '%)
+ ;; compute the column where the % numbers need to go
+ (setq pcol (+ 2
+ (if multifile 1 0)
+ (if level-p 1 0)
+ (if timestamp 1 0)
+ (min maxlevel (or ntcol 100))))
+ ;; compute the column where the total time is
+ (setq tcol (+ 2
+ (if multifile 1 0)
+ (if level-p 1 0)
+ (if timestamp 1 0)))
+ (insert
+ (format
+ "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
+ pcol ; the column where the % numbers should go
+ (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time
+ tcol ; column of the total time
+ tcol (1- pcol) ; range of columns where times can be found
+ ))
+ (setq recalc t))
+ ((stringp formula)
+ (insert "\n#+TBLFM: " formula)
+ (setq recalc t))
+ (t (error "invalid formula in clocktable")))
+ ;; Should we rescue an old formula?
+ (when (stringp (setq content (plist-get params :content)))
+ (when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content)
+ (setq recalc t)
+ (insert "\n" (match-string 1 (plist-get params :content)))
+ (beginning-of-line 0))))
+ ;; Back to beginning, align the table, recalculate if necessary
+ (goto-char ipos)
+ (skip-chars-forward "^|")
+ (org-table-align)
+ (when org-hide-emphasis-markers
+ ;; we need to align a second time
+ (org-table-align))
+ (when recalc
+ (if (eq formula '%)
+ (save-excursion
+ (if (and narrow (not narrow-cut-p)) (beginning-of-line 2))
+ (org-table-goto-column pcol nil 'force)
+ (insert "%")))
+ (org-table-recalculate 'all))
+ (when rm-file-column
+ ;; The file column is actually not wanted
+ (forward-char 1)
+ (org-table-delete-column))
+ 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 " "))))
(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))
(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)
+ cc range-text step-time)
(when block
(setq cc (org-clock-special-range block nil t)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
- (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)))))
+ (cond
+ ((numberp ts)
+ ;; If ts is a number, it's an absolute day number from org-agenda.
+ (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts)
+ (setq ts (org-float-time (encode-time 0 0 0 day month year)))))
+ (ts
+ (setq ts (org-float-time
+ (apply 'encode-time (org-parse-time-string ts))))))
+ (cond
+ ((numberp te)
+ ;; Likewise for te.
+ (destructuring-bind (month day year) (calendar-gregorian-from-absolute te)
+ (setq te (org-float-time (encode-time 0 0 0 day month year)))))
+ (te
+ (setq te (org-float-time
+ (apply 'encode-time (org-parse-time-string te))))))
(setq p1 (plist-put p1 :header ""))
(setq p1 (plist-put p1 :step nil))
(setq p1 (plist-put p1 :block nil))
(setq p1 (plist-put p1 :tend (format-time-string
(org-time-stamp-format nil t)
(seconds-to-time (setq ts (+ ts step))))))
- (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ")
+ (insert "\n" (if (eq step0 'day) "Daily report: "
+ "Weekly report starting on: ")
(plist-get p1 :tstart) "\n")
- (org-dblock-write:clocktable p1)
- (re-search-forward "#\\+END:")
+ (setq step-time (org-dblock-write:clocktable p1))
+ (re-search-forward "^[ \t]*#\\+END:")
+ (when (and (equal step-time 0) stepskip0)
+ ;; Remove the empty table
+ (delete-region (point-at-bol)
+ (save-excursion
+ (re-search-backward "^\\(Daily\\|Weekly\\) report"
+ nil t)
+ (point))))
(end-of-line 0))))
-(defun org-clocktable-add-file (file table)
- (if table
- (let ((lines (org-split-string table "\n"))
- (ff (file-name-nondirectory file)))
- (mapconcat 'identity
- (mapcar (lambda (x)
- (if (string-match org-table-dataline-regexp x)
- (concat "|" ff x)
- x))
- lines)
- "\n"))))
+(defun org-clock-get-table-data (file params)
+ "Get the clocktable data for file FILE, with parameters PARAMS.
+FILE is only for identification - this function assumes that
+the correct buffer is current, and that the wanted restriction is
+in place.
+The return value will be a list with the file name and the total
+file time (in minutes) as 1st and 2nd elements. The third element
+of this list will be a list of headline entries. Each entry has the
+following structure:
+
+ (LEVEL HEADLINE TIMESTAMP TIME)
+
+LEVEL: The level of the headline, as an integer. This will be
+ the reduced leve, so 1,2,3,... even if only odd levels
+ are being used.
+HEADLINE: The text of the headline. Depending on PARAMS, this may
+ already be formatted like a link.
+TIMESTAMP: If PARAMS require it, this will be a time stamp found in the
+ entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive,
+ in this sequence.
+TIME: The sum of all time spend in this tree, in minutes. This time
+ will of cause be restricted to the time block and tags match
+ specified in PARAMS."
+ (let* ((maxlevel (or (plist-get params :maxlevel) 3))
+ (timestamp (plist-get params :timestamp))
+ (ts (plist-get params :tstart))
+ (te (plist-get params :tend))
+ (block (plist-get params :block))
+ (link (plist-get params :link))
+ (tags (plist-get params :tags))
+ (matcher (if tags (cdr (org-make-tags-matcher tags))))
+ cc range-text st p time level hdl props tsp tbl)
+
+ (setq org-clock-file-total-minutes nil)
+ (when block
+ (setq cc (org-clock-special-range block nil t)
+ 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)))
+ (when (and ts (listp ts))
+ (setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts))))
+ (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)))))
+ (save-excursion
+ (org-clock-sum ts te
+ (unless (null matcher)
+ (lambda ()
+ (let ((tags-list (org-get-tags-at)))
+ (eval matcher)))))
+ (goto-char (point-min))
+ (setq st t)
+ (while (or (and (bobp) (prog1 st (setq st nil))
+ (get-text-property (point) :org-clock-minutes)
+ (setq p (point-min)))
+ (setq p (next-single-property-change
+ (point) :org-clock-minutes)))
+ (goto-char p)
+ (when (setq time (get-text-property p :org-clock-minutes))
+ (save-excursion
+ (beginning-of-line 1)
+ (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
+ (setq level (org-reduced-level
+ (- (match-end 1) (match-beginning 1))))
+ (<= level maxlevel))
+ (setq hdl (if (not link)
+ (match-string 2)
+ (org-make-link-string
+ (format "file:%s::%s"
+ (buffer-file-name)
+ (save-match-data
+ (org-make-org-heading-search-string
+ (match-string 2))))
+ (match-string 2)))
+ tsp (when timestamp
+ (setq props (org-entry-properties (point)))
+ (or (cdr (assoc "SCHEDULED" props))
+ (cdr (assoc "DEADLINE" props))
+ (cdr (assoc "TIMESTAMP" props))
+ (cdr (assoc "TIMESTAMP_IA" props)))))
+ (when (> time 0) (push (list level hdl tsp time) tbl))))))
+ (setq tbl (nreverse tbl))
+ (list file org-clock-file-total-minutes tbl))))
(defun org-clock-time% (total &rest strings)
"Compute a time fraction in percent.
(if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
(throw 'exit
(/ (* 100.0 (+ (string-to-number (match-string 2 s))
- (* 60 (string-to-number (match-string 1 s)))))
+ (* 60 (string-to-number
+ (match-string 1 s)))))
tot))))
0))))
+(defvar org-clock-loaded nil
+ "Was the clock file loaded?")
+
(defun org-clock-save ()
"Persist various clock-related data to disk.
The details of what will be saved are regulated by the variable
`org-clock-persist'."
- (when org-clock-persist
+ (when (and org-clock-persist
+ (or org-clock-loaded
+ org-clock-has-been-used
+ (not (file-exists-p org-clock-persist-file))))
(let (b)
(with-current-buffer (find-file (expand-file-name org-clock-persist-file))
(progn
(insert (format ";; org-persist.el - %s at %s\n"
system-name (format-time-string
(cdr org-time-stamp-formats))))
- (if (and (setq b (marker-buffer org-clock-marker))
+ (if (and (memq org-clock-persist '(t clock))
+ (setq b (org-clocking-buffer))
(setq b (or (buffer-base-buffer b) b))
(buffer-live-p b)
(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)
+ (substring-no-properties
+ org-clock-heading)
") "))))
(insert "(setq resume-clock '(\""
- (buffer-file-name (marker-buffer org-clock-marker))
+ (buffer-file-name (org-clocking-buffer))
"\" . " (int-to-string (marker-position org-clock-marker))
"))\n"))
;; Store clocked task history. Tasks are stored reversed to make
;; reading simpler
- (when (and org-clock-history (eq org-clock-persist t))
+ (when (and (memq org-clock-persist '(t history))
+ org-clock-history)
(insert
"(setq stored-clock-history '("
(mapconcat
(save-buffer)
(kill-buffer (current-buffer)))))))
-(defvar org-clock-loaded nil
- "Was the clock file loaded?")
-
(defun org-clock-load ()
"Load clock-related data from disk, maybe resuming a stored clock."
(when (and org-clock-persist (not org-clock-loaded))
(when (file-exists-p (car resume-clock))
(with-current-buffer (find-file (car resume-clock))
(goto-char (cdr resume-clock))
- (org-clock-in)
- (if (org-invisible-p)
- (org-show-context)))))))))
+ (let ((org-clock-auto-clock-resolution nil))
+ (org-clock-in)
+ (if (org-invisible-p)
+ (org-show-context))))))))))
;;;###autoload
(defun org-clock-persistence-insinuate ()
- "Set up hooks for clock persistence"
+ "Set up hooks for clock persistence."
(add-hook 'org-mode-hook 'org-clock-load)
(add-hook 'kill-emacs-hook 'org-clock-save))
;; arch-tag: 7b42c5d4-9b36-48be-97c0-66a869daed4c
;;; org-clock.el ends here
+
HCoop / bpt / emacs.git / blobdiff