;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.4
+;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
;; This file contains the time clocking code for Org-mode
(require 'org)
+(require 'org-exp)
;;; Code:
(eval-when-compile
(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
(declare-function notifications-notify "notifications" (&rest params))
(defvar org-time-stamp-formats)
+(defvar org-ts-what)
(defgroup org-clock nil
"Options concerning clocking working time in Org-mode."
(const :tag "Into LOGBOOK drawer" "LOGBOOK")
(string :tag "Into Drawer named...")))
+(defun org-clock-into-drawer ()
+ "Return the value of `org-clock-into-drawer', but let properties overrule.
+If the current entry has or inherits a CLOCK_INTO_DRAWER
+property, it will be used instead of the default value; otherwise
+if the current entry has or inherits a LOG_INTO_DRAWER property,
+it will be used instead of the default value.
+The default is the value of the customizable variable `org-clock-into-drawer',
+which see."
+ (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit))
+ (q (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))
+ (cond
+ ((or (not (or p q)) (equal p "nil") (equal q "nil")) org-clock-into-drawer)
+ ((or (equal p "t") (equal q "t")) "LOGBOOK")
+ ((not p) q)
+ (t p))))
+
(defcustom org-clock-out-when-done t
"When non-nil, clock will be stopped when the clocked entry is marked DONE.
DONE here means any DONE-like state.
: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)
+ `(list
+ :maxlevel 2
+ :lang ,org-export-default-language
+ :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)
:group 'org-clocktable
:type 'function)
+;; FIXME: translate es and nl last string "Clock summary at"
+(defcustom org-clock-clocktable-language-setup
+ '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at")
+ ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at")
+ ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à")
+ ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at"))
+ "Terms used in clocktable, translated to different languages."
+ :group 'org-clocktable
+ :type 'alist)
+
(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
"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
(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.")
"Return t when clocking a task."
(not (equal (org-clocking-buffer) nil)))
+(defvar org-clock-before-select-task-hook nil
+ "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."
(interactive)
(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))
(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)))
+ cat (org-get-category)
heading (org-get-heading 'notags)
prefix (save-excursion
(org-back-to-heading t)
- (looking-at "\\*+ ")
+ (looking-at org-outline-regexp)
(match-string 0))
task (substring
(org-fontify-like-in-org-mode
(m (- clocked-time (* 60 h))))
(if org-clock-effort
(let* ((effort-in-minutes
- (org-hh:mm-string-to-minutes org-clock-effort))
+ (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
;; 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 current)
+ (setq current (org-duration-string-to-minutes current)
value (substring value 1))
(setq current 0))
- (setq value (org-hh:mm-string-to-minutes value))
+ (setq value (org-duration-string-to-minutes value))
(if (equal ?- sign)
(setq value (- current value))
(if (equal ?+ sign) (setq value (+ current value)))))
"Show notification if we spent more time than we estimated before.
Notification is shown only once."
(when (org-clocking-p)
- (let ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort))
+ (let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort))
(clocked-time (org-clock-get-clocked-time)))
(if (setq org-task-overrun
(if (or (null effort-in-minutes) (zerop effort-in-minutes))
(defun org-clock-jump-to-current-clock (&optional effective-clock)
(interactive)
- (let ((clock (or effective-clock (cons org-clock-marker
+ (let ((org-clock-into-drawer (org-clock-into-drawer))
+ (clock (or effective-clock (cons org-clock-marker
org-clock-start-time))))
(unless (marker-buffer (car clock))
(error "No clock is currently running"))
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))
+
(defun org-clock-in (&optional select start-time)
"Start the clock on the current item.
If necessary, clock-out of the currently active clock.
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))
(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
(setq selected-task (copy-marker selected-task))
(error "Abort")))
+
+ (when (equal select '(16))
+ ;; Mark as default clocking task
+ (org-clock-mark-default-task))
+
(when interrupting
;; We are interrupting the clocking of a different task.
;; Save a marker to this task, so that we can go back.
(= (marker-position org-clock-hd-marker)
(if selected-task
(marker-position selected-task)
- (point)))))
+ (point)))
+ (equal org-clock-current-task (nth 4 (org-heading-components)))))
(message "Clock continues in \"%s\"" org-clock-heading)
(throw 'abort nil))
(move-marker org-clock-interrupted-task
(let ((org-clock-clocking-in t))
(org-clock-out t)))
- (when (equal select '(16))
- ;; Mark as default clocking task
- (org-clock-mark-default-task))
-
;; Clock in at which position?
(setq target-pos
(if (and (eobp) (not (org-on-heading-p)))
(match-string 2))))
(if newstate (org-todo newstate))))
((and org-clock-in-switch-to-state
- (not (looking-at (concat outline-regexp "[ \t]*"
+ (not (looking-at (concat org-outline-regexp "[ \t]*"
org-clock-in-switch-to-state
"\\>"))))
(org-todo org-clock-in-switch-to-state)))
(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)
line and position cursor in that line."
(org-back-to-heading t)
(catch 'exit
- (let ((beg (save-excursion
- (beginning-of-line 2)
- (or (bolp) (newline))
- (point)))
- (end (progn (outline-next-heading) (point)))
- (re (concat "^[ \t]*" org-clock-string))
- (cnt 0)
- (drawer (if (stringp org-clock-into-drawer)
- org-clock-into-drawer "LOGBOOK"))
- first last ind-last)
+ (let* ((org-clock-into-drawer (org-clock-into-drawer))
+ (beg (save-excursion
+ (beginning-of-line 2)
+ (or (bolp) (newline))
+ (point)))
+ (end (progn (outline-next-heading) (point)))
+ (re (concat "^[ \t]*" org-clock-string))
+ (cnt 0)
+ (drawer (if (stringp org-clock-into-drawer)
+ org-clock-into-drawer "LOGBOOK"))
+ first last ind-last)
(goto-char beg)
(when (and find-unclosed
(re-search-forward
(and (re-search-forward org-property-end-re nil t)
(goto-char (match-beginning 0))))
(throw 'exit t))
- ;; Lets count the CLOCK lines
+ ;; Let's count the CLOCK lines
(goto-char beg)
(while (re-search-forward re end t)
(setq first (or first (match-beginning 0))
(beginning-of-line 2)
(if (and (>= (org-get-indentation) ind-last)
(org-at-item-p))
- (org-end-of-item))
+ (when (and (>= (org-get-indentation) ind-last)
+ (org-at-item-p))
+ (let ((struct (org-list-struct)))
+ (goto-char (org-list-get-bottom-point struct)))))
(insert ":END:\n")
(beginning-of-line 0)
(org-indent-line-to ind-last)
(match-string 2))))
(if newstate (org-todo newstate))))
((and org-clock-out-switch-to-state
- (not (looking-at (concat outline-regexp "[ \t]*"
+ (not (looking-at (concat org-outline-regexp "[ \t]*"
org-clock-out-switch-to-state
"\\>"))))
(org-todo org-clock-out-switch-to-state))))))
(run-hooks 'org-clock-out-hook)
(org-clock-delete-current))))))
+(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer)
+
+(defun org-clock-remove-empty-clock-drawer nil
+ "Remove empty clock drawer in the current subtree."
+ (let* ((olid (or (org-entry-get (point) "LOG_INTO_DRAWER")
+ org-log-into-drawer))
+ (clock-drawer (if (eq t olid) "LOGBOOK" olid))
+ (end (save-excursion (org-end-of-subtree t t))))
+ (when clock-drawer
+ (save-excursion
+ (org-back-to-heading t)
+ (while (search-forward clock-drawer end t)
+ (goto-char (match-beginning 0))
+ (org-remove-empty-drawer-at clock-drawer (point))
+ (forward-line 1))))))
+
+(defun org-at-clock-log-p nil
+ "Is the cursor on the clock log line?"
+ (save-excursion
+ (move-beginning-of-line 1)
+ (looking-at "^[ \t]*CLOCK:")))
+
+(defun org-clock-timestamps-up nil
+ "Increase CLOCK timestamps at cursor."
+ (interactive)
+ (org-clock-timestamps-change 'up))
+
+(defun org-clock-timestamps-down nil
+ "Increase CLOCK timestamps at cursor."
+ (interactive)
+ (org-clock-timestamps-change 'down))
+
+(defun org-clock-timestamps-change (updown)
+ "Change CLOCK timestamps synchronously at cursor.
+UPDOWN tells whether to change 'up or 'down."
+ (setq org-ts-what nil)
+ (when (org-at-timestamp-p t)
+ (let ((tschange (if (eq updown 'up) 'org-timestamp-up
+ 'org-timestamp-down))
+ ts1 begts1 ts2 begts2 updatets1 tdiff)
+ (save-excursion
+ (move-beginning-of-line 1)
+ (re-search-forward org-ts-regexp3 nil t)
+ (setq ts1 (match-string 0) begts1 (match-beginning 0))
+ (when (re-search-forward org-ts-regexp3 nil t)
+ (setq ts2 (match-string 0) begts2 (match-beginning 0))))
+ ;; Are we on the second timestamp?
+ (if (<= begts2 (point)) (setq updatets1 t))
+ (if (not ts2)
+ ;; fall back on org-timestamp-up if there is only one
+ (funcall tschange)
+ ;; setq this so that (boundp 'org-ts-what is non-nil)
+ (funcall tschange)
+ (let ((ts (if updatets1 ts2 ts1))
+ (begts (if updatets1 begts1 begts2)))
+ (setq tdiff
+ (subtract-time
+ (org-time-string-to-time org-last-changed-timestamp)
+ (org-time-string-to-time ts)))
+ (save-excursion
+ (goto-char begts)
+ (org-timestamp-change
+ (round (/ (org-float-time tdiff)
+ (cond ((eq org-ts-what 'minute) 60)
+ ((eq org-ts-what 'hour) 3600)
+ ((eq org-ts-what 'day) (* 24 3600))
+ ((eq org-ts-what 'month) (* 24 3600 31))
+ ((eq org-ts-what 'year) (* 24 3600 365.2)))))
+ org-ts-what 'updown)))))))
+
(defun org-clock-cancel ()
"Cancel the running clock by removing the start timestamp."
(interactive)
(defun org-clock-display (&optional total-only)
"Show subtree times in the entire buffer.
If TOTAL-ONLY is non-nil, only show the total time for the entire file
-in the echo area."
+in the echo area.
+
+Use \\[org-clock-remove-overlays] to remove the subtree times."
(interactive)
(org-clock-remove-overlays)
(let (time h m p)
(defun org-clock-report (&optional arg)
"Create a table containing a report about clocked time.
If the cursor is inside an existing clocktable block, then the table
-will be updated. If not, a new clocktable will be inserted.
+will be updated. If not, a new clocktable will be inserted. The scope
+of the new clock will be subtree when called from within a subtree, and
+file elsewhere.
+
When called with a prefix argument, move to the first clock table in the
buffer and update it."
(interactive "P")
(org-show-entry))
(if (org-in-clocktable-p)
(goto-char (org-in-clocktable-p))
- (org-create-dblock (append (list :name "clocktable")
- org-clock-clocktable-default-properties)))
+ (let ((props (if (ignore-errors
+ (save-excursion (org-back-to-heading)))
+ (list :name "clocktable" :scope 'subtree)
+ (list :name "clocktable"))))
+ (org-create-dblock
+ (org-combine-plists org-clock-clocktable-default-properties props))))
(org-update-dblock))
(defun org-in-clocktable-p ()
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
+ ((> (+ q shift) 0) ; shift is within 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))))
(setq level (string-to-number (match-string 1 (symbol-name scope))))
(catch 'exit
(while (org-up-heading-safe)
- (looking-at outline-regexp)
+ (looking-at org-outline-regexp)
(if (<= (org-reduced-level (funcall outline-level)) level)
(throw 'exit nil))))
(org-narrow-to-subtree)))
"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...
+from the dynamic block definition."
+ ;; This function looks quite complicated, mainly because there are a
+ ;; lot of options which can add or remove columns. I have massively
+ ;; commented this function, the I hope it is understandable. If
+ ;; someone wants to write their 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 . "/")))
+ (lwords (assoc (or (plist-get params :lang)
+ org-export-default-language)
+ org-clock-clocktable-language-setup))
(multifile (plist-get params :multifile))
(block (plist-get params :block))
(ts (plist-get params :tstart))
(emph (plist-get params :emphasize))
(level-p (plist-get params :level))
(timestamp (plist-get params :timestamp))
+ (properties (plist-get params :properties))
(ntcol (max 1 (or (plist-get params :tcolumns) 100)))
(rm-file-column (plist-get params :one-file-with-archives))
(indent (plist-get params :indent))
(or header
;; Format the standard header
(concat
- "Clock summary at ["
+ (nth 9 lwords) " ["
(substring
(format-time-string (cdr org-time-stamp-formats))
1 -1)
(if multifile "|" "") ; file column, maybe
(if level-p "|" "") ; level column, maybe
(if timestamp "|" "") ; timestamp column, maybe
+ (if properties (make-string (length properties) ?|) "") ;properties columns, 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
+ (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe
+ (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe
+ (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe
+ (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe
+ (concat (nth 4 lwords) "|"
+ (nth 5 lwords) "|\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
+ "|-\n" ; a hline
+ "|" ; table line starter
+ (if multifile (concat "| " (nth 6 lwords) " ") "")
+ ; file column, maybe
+ (if level-p "|" "") ; level column, maybe
+ (if timestamp "|" "") ; timestamp column, maybe
+ (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
+ (concat "*" (nth 7 lwords) "*| ") ; instead of a headline
"*"
(org-minutes-to-hh:mm-string (or total-time 0)) ; the time
"*|\n") ; close line
(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
+ ;; Summarize the time collected from this file
(insert-before-markers
- (format "| %s %s | %s*File time* | *%s*|\n"
+ (format (concat "| %s %s | %s%s*" (nth 8 lwords) "* | *%s*|\n")
(file-name-nondirectory (car tbl))
(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
;; Get the list of node entries and iterate over it
(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 properties
+ (concat
+ (mapconcat
+ (lambda (p) (or (cdr (assoc p (nth 4 entry))) ""))
+ properties "|") "|") "") ;properties columns, maybe
(if indent (org-clocktable-indent-string level) "") ; indentation
hlc headline hlc "|" ; headline
(make-string (min (1- ntcol) (or (- level 1))) ?|)
(block (plist-get params :block))
(link (plist-get params :link))
(tags (plist-get params :tags))
+ (properties (plist-get params :properties))
+ (inherit-property-p (plist-get params :inherit-props))
(matcher (if tags (cdr (org-make-tags-matcher tags))))
cc range-text st p time level hdl props tsp tbl)
(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))))))
+ (cdr (assoc "TIMESTAMP_IA" props))))
+ props (when properties
+ (remove nil
+ (mapcar
+ (lambda (p)
+ (when (org-entry-get (point) p inherit-property-p)
+ (cons p (org-entry-get (point) p inherit-property-p))))
+ properties))))
+ (when (> time 0) (push (list level hdl tsp time props) tbl))))))
(setq tbl (nreverse tbl))
(list file org-clock-file-total-minutes tbl))))
tot))))
0))))
+;; Saving and loading the clock
+
(defvar org-clock-loaded nil
"Was the clock file loaded?")
(goto-char (cdr resume-clock))
(let ((org-clock-auto-clock-resolution nil))
(org-clock-in)
- (if (org-invisible-p)
+ (if (outline-invisible-p)
(org-show-context))))))))))
;;;###autoload
(provide 'org-clock)
-;;; org-clock.el ends here
+;;; org-clock.el ends here