summaryrefslogtreecommitdiff
path: root/lisp/org-clock.el
diff options
context:
space:
mode:
authorSébastien Delafond <sdelafond@gmail.com>2015-08-25 12:27:35 +0200
committerSébastien Delafond <sdelafond@gmail.com>2015-08-25 12:27:35 +0200
commit1be13d57dc8357576a8285c6dadc03db9e3ed7b0 (patch)
treee35b32d4dbd60cb6cea09f3c0797cc8877352def /lisp/org-clock.el
parent4dc4918d0d667f18f3d5e3dd71e6f117ddb8af8a (diff)
Imported Upstream version 8.3.1
Diffstat (limited to 'lisp/org-clock.el')
-rw-r--r--lisp/org-clock.el740
1 files changed, 437 insertions, 303 deletions
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 892ae18..6e34483 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -32,10 +32,12 @@
(require 'cl))
(require 'org)
-(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
+(declare-function calendar-iso-to-absolute "cal-iso" (&optional date))
(declare-function notifications-notify "notifications" (&rest params))
(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
-(declare-function org-refresh-properties "org" (dprop tprop))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-table-goto-line "org-table" (n))
(defvar org-time-stamp-formats)
(defvar org-ts-what)
(defvar org-frame-title-format-backup frame-title-format)
@@ -45,19 +47,26 @@
:tag "Org Clock"
:group 'org-progress)
-(defcustom org-clock-into-drawer org-log-into-drawer
- "Should clocking info be wrapped into a drawer?
-When t, clocking info will always be inserted into a :LOGBOOK: drawer.
-If necessary, the drawer will be created.
-When nil, the drawer will not be created, but used when present.
-When an integer and the number of clocking entries in an item
-reaches or exceeds this number, a drawer will be created.
-When a string, it names the drawer to be used.
-
-The default for this variable is the value of `org-log-into-drawer',
-which see."
+(defcustom org-clock-into-drawer t
+ "Non-nil when clocking info should be wrapped into a drawer.
+
+When non-nil, clocking info will be inserted into the same drawer
+as log notes (see variable `org-log-into-drawer'), if it exists,
+or \"LOGBOOK\" otherwise. If necessary, the drawer will be
+created.
+
+When an integer, the drawer is created only when the number of
+clocking entries in an item reaches or exceeds this value.
+
+When a string, it becomes the name of the drawer, ignoring the
+log notes drawer altogether.
+
+Do not check directly this variable in a Lisp program. Call
+function `org-clock-into-drawer' instead."
:group 'org-todo
:group 'org-clock
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type '(choice
(const :tag "Always" t)
(const :tag "Only when drawer exists" nil)
@@ -66,20 +75,22 @@ which see."
(string :tag "Into Drawer named...")))
(defun org-clock-into-drawer ()
- "Return the value of `org-clock-into-drawer', but let properties overrule.
+ "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))))
+property, it will be used instead of the default value.
+
+Return value is either a string, an integer, or nil."
+ (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit t)))
+ (cond ((equal p "nil") nil)
+ ((equal p "t") (or (org-log-into-drawer) "LOGBOOK"))
+ ((org-string-nw-p p)
+ (if (org-string-match-p "\\`[0-9]+\\'" p) (string-to-number p) p))
+ ((org-string-nw-p org-clock-into-drawer))
+ ((integerp org-clock-into-drawer) org-clock-into-drawer)
+ ((not org-clock-into-drawer) nil)
+ ((org-log-into-drawer))
+ (t "LOGBOOK"))))
(defcustom org-clock-out-when-done t
"When non-nil, clock will be stopped when the clocked entry is marked DONE.
@@ -413,6 +424,26 @@ if you are using Debian."
:package-version '(Org . "8.0")
:type 'string)
+(defcustom org-clock-goto-before-context 2
+ "Number of lines of context to display before currently clocked-in entry.
+This applies when using `org-clock-goto'."
+ :group 'org-clock
+ :type 'integer)
+
+(defcustom org-clock-display-default-range 'thisyear
+ "Default range when displaying clocks with `org-clock-display'."
+ :group 'org-clock
+ :type '(choice (const today)
+ (const yesterday)
+ (const thisweek)
+ (const lastweek)
+ (const thismonth)
+ (const lastmonth)
+ (const thisyear)
+ (const lastyear)
+ (const untilnow)
+ (const :tag "Select range interactively" interactive)))
+
(defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock.
This hook is run before anything happens to the task that
@@ -430,6 +461,28 @@ to add an effort property.")
(defvar org-clock-has-been-used nil
"Has the clock been used during the current Emacs session?")
+(defconst org-clock--oldest-date
+ (let* ((dichotomy
+ (lambda (min max pred)
+ (if (funcall pred min) min
+ (incf min)
+ (while (> (- max min) 1)
+ (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1))))
+ (if (funcall pred mean) (setq max mean) (setq min mean)))))
+ max))
+ (high
+ (funcall dichotomy
+ most-negative-fixnum
+ 0
+ (lambda (m) (ignore-errors (decode-time (list m 0))))))
+ (low
+ (funcall dichotomy
+ most-negative-fixnum
+ 0
+ (lambda (m) (ignore-errors (decode-time (list high m)))))))
+ (list high low))
+ "Internal time for oldest date representable on the system.")
+
;;; The clock for measuring work time.
(defvar org-mode-line-string "")
@@ -559,6 +612,7 @@ of a different task.")
(fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl)))
(message (or prompt "Select task for clocking:"))
(setq cursor-type nil rpl (read-char-exclusive))
+ (kill-buffer)
(cond
((eq rpl ?q) nil)
((eq rpl ?x) nil)
@@ -775,11 +829,12 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
"Search through the given file and find all open clocks."
(let ((buf (or (get-file-buffer file)
(find-file-noselect file)))
+ (org-clock-re (concat org-clock-string " \\(\\[.*?\\]\\)$"))
clocks)
(with-current-buffer buf
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t)
+ (while (re-search-forward org-clock-re nil t)
(push (cons (copy-marker (match-end 1) t)
(org-time-string-to-time (match-string 1))) clocks))))
clocks))
@@ -884,7 +939,7 @@ If necessary, clock-out of the currently active clock."
(defun org-clock-jump-to-current-clock (&optional effective-clock)
(interactive)
- (let ((org-clock-into-drawer (org-clock-into-drawer))
+ (let ((drawer (org-clock-into-drawer))
(clock (or effective-clock (cons org-clock-marker
org-clock-start-time))))
(unless (marker-buffer (car clock))
@@ -892,23 +947,18 @@ If necessary, clock-out of the currently active clock."
(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)))))))
+ (when drawer
+ (org-with-wide-buffer
+ (let ((drawer-re (format "^[ \t]*:%s:[ \t]*$"
+ (regexp-quote (or drawer "LOGBOOK"))))
+ (beg (save-excursion (outline-back-to-heading t) (point))))
+ (catch 'exit
+ (while (re-search-backward drawer-re beg t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'drawer)
+ (when (> (org-element-property :end element) (car clock))
+ (org-flag-drawer nil element))
+ (throw 'exit nil)))))))))))
(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
"Resolve an open org-mode clock.
@@ -1046,9 +1096,9 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(lambda (clock)
(format
"Dangling clock started %d mins ago"
- (floor
- (/ (- (org-float-time (current-time))
- (org-float-time (cdr clock))) 60))))))
+ (floor (- (org-float-time)
+ (org-float-time (cdr clock)))
+ 60)))))
(or last-valid
(cdr clock)))))))))))
@@ -1066,9 +1116,11 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(defvar org-x11idle-exists-p
;; Check that x11idle exists
(and (eq window-system 'x)
- (eq (call-process-shell-command "command" nil nil nil "-v" org-clock-x11idle-program-name) 0)
+ (eq 0 (call-process-shell-command
+ (format "command -v %s" org-clock-x11idle-program-name)))
;; Check that x11idle can retrieve the idle time
- (eq (call-process-shell-command org-clock-x11idle-program-name nil nil nil) 0)))
+ ;; FIXME: Why "..-shell-command" rather than just `call-process'?
+ (eq 0 (call-process-shell-command org-clock-x11idle-program-name))))
(defun org-x11-idle-seconds ()
"Return the current X11 idle time in seconds."
@@ -1130,7 +1182,9 @@ time as the start time \(see `org-clock-continuously' to
make this the default behavior.)"
(interactive "P")
(setq org-clock-notification-was-shown nil)
- (org-refresh-properties org-effort-property 'org-effort)
+ (org-refresh-properties
+ org-effort-property '((effort . identity)
+ (effort-minutes . org-duration-string-to-minutes)))
(catch 'abort
(let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
(org-clocking-p)))
@@ -1321,8 +1375,7 @@ With three universal prefix arguments, interactively prompt
for a todo state to switch to, overriding the existing value
`org-clock-in-switch-to-state'."
(interactive "P")
- (if (equal arg '(4))
- (org-clock-in (org-clock-select-task))
+ (if (equal arg '(4)) (org-clock-in arg)
(let ((start-time (if (or org-clock-continuously (equal arg '(16)))
(or org-clock-out-time
(org-current-time org-clock-rounding-minutes t))
@@ -1368,10 +1421,12 @@ decides which time to use."
(current-time))
((equal cmt "today")
(setq org--msg-extra "showing today's task time.")
- (let* ((dt (decode-time (current-time))))
- (setq dt (append (list 0 0 0) (nthcdr 3 dt)))
- (if org-extend-today-until
- (setf (nth 2 dt) org-extend-today-until))
+ (let* ((dt (decode-time))
+ (hour (nth 2 dt))
+ (day (nth 3 dt)))
+ (if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day)))
+ (setf (nth 2 dt) org-extend-today-until)
+ (setq dt (append (list 0 0) (nthcdr 2 dt)))
(apply 'encode-time dt)))
((or (equal cmt "all")
(and (or (not cmt) (equal cmt "auto"))
@@ -1393,87 +1448,100 @@ When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock
line and position cursor in that line."
(org-back-to-heading t)
(catch 'exit
- (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
- (concat "^[ \t]*" org-clock-string
- " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
- " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")
- end t))
- (beginning-of-line 1)
- (throw 'exit t))
- (when (eobp) (newline) (setq end (max (point) end)))
- (when (re-search-forward (concat "^[ \t]*:" drawer ":") end t)
- ;; we seem to have a CLOCK drawer, so go there.
- (beginning-of-line 2)
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (match-beginning 0))))
- (throw 'exit t))
- ;; Lets count the CLOCK lines
+ (let* ((beg (line-beginning-position 2))
+ (end (save-excursion (outline-next-heading) (point)))
+ (org-clock-into-drawer (org-clock-into-drawer))
+ (drawer (cond
+ ((not org-clock-into-drawer) nil)
+ ((stringp org-clock-into-drawer) org-clock-into-drawer)
+ (t "LOGBOOK"))))
+ ;; Look for a running clock if FIND-UNCLOSED in non-nil.
+ (when find-unclosed
+ (let ((open-clock-re
+ (concat "^[ \t]*"
+ org-clock-string
+ " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
+ " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
+ (while (re-search-forward open-clock-re end t)
+ (let ((element (org-element-at-point)))
+ (when (and (eq (org-element-type element) 'clock)
+ (eq (org-element-property :status element) 'running))
+ (beginning-of-line)
+ (throw 'exit t))))))
+ ;; Look for an existing clock drawer.
+ (when drawer
+ (goto-char beg)
+ (let ((drawer-re (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$")))
+ (while (re-search-forward drawer-re end t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'drawer)
+ (let ((cend (org-element-property :contents-end element)))
+ (if (and (not org-log-states-order-reversed) cend)
+ (goto-char cend)
+ (forward-line))
+ (throw 'exit t)))))))
(goto-char beg)
- (while (re-search-forward re end t)
- (setq first (or first (match-beginning 0))
- last (match-beginning 0)
- cnt (1+ cnt)))
- (when (and (integerp org-clock-into-drawer)
- last
- (>= (1+ cnt) org-clock-into-drawer))
- ;; Wrap current entries into a new drawer
- (goto-char last)
- (setq ind-last (org-get-indentation))
- (beginning-of-line 2)
- (if (and (>= (org-get-indentation) ind-last)
- (org-at-item-p))
- (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)
- (goto-char first)
- (insert ":" drawer ":\n")
- (beginning-of-line 0)
- (org-indent-line)
- (org-flag-drawer t)
- (beginning-of-line 2)
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (match-beginning 0))))
- (throw 'exit nil))
-
- (goto-char beg)
- (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
- (not (equal (match-string 1) org-clock-string)))
- ;; Planning info, skip to after it
- (beginning-of-line 2)
- (or (bolp) (newline)))
- (when (or (eq org-clock-into-drawer t)
- (stringp org-clock-into-drawer)
- (and (integerp org-clock-into-drawer)
- (< org-clock-into-drawer 2)))
- (insert ":" drawer ":\n:END:\n")
- (beginning-of-line -1)
- (org-indent-line)
- (org-flag-drawer t)
- (beginning-of-line 2)
- (org-indent-line)
- (beginning-of-line)
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (match-beginning 0))))))))
+ (let ((clock-re (concat "^[ \t]*" org-clock-string))
+ (count 0) positions first)
+ ;; Count the CLOCK lines and store their positions.
+ (save-excursion
+ (while (re-search-forward clock-re end t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'clock)
+ (setq positions (cons (line-beginning-position) positions)
+ count (1+ count))))))
+ (cond
+ ((null positions)
+ ;; Skip planning line and property drawer, if any.
+ (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0))
+ (forward-line))
+ (unless (bolp) (insert "\n"))
+ ;; Create a new drawer if necessary.
+ (when (and org-clock-into-drawer
+ (or (not (wholenump org-clock-into-drawer))
+ (< org-clock-into-drawer 2)))
+ (let ((beg (point)))
+ (insert ":" drawer ":\n:END:\n")
+ (org-indent-region beg (point))
+ (goto-char beg)
+ (org-flag-drawer t)
+ (forward-line))))
+ ;; When a clock drawer needs to be created because of the
+ ;; number of clock items, collect all clocks in the section
+ ;; and wrap them within the drawer.
+ ((and (wholenump org-clock-into-drawer)
+ (>= (1+ count) org-clock-into-drawer))
+ ;; Skip planning line and property drawer, if any.
+ (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0))
+ (forward-line))
+ (let ((beg (point)))
+ (insert
+ (mapconcat
+ (lambda (p)
+ (save-excursion
+ (goto-char p)
+ (org-trim (delete-and-extract-region
+ (save-excursion (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))
+ (line-beginning-position 2)))))
+ positions "\n")
+ "\n:END:\n")
+ (let ((end (point-marker)))
+ (goto-char beg)
+ (save-excursion (insert ":" drawer ":\n"))
+ (org-flag-drawer t)
+ (org-indent-region (point) end)
+ (forward-line)
+ (unless org-log-states-order-reversed
+ (goto-char end)
+ (beginning-of-line -1))
+ (set-marker end nil))))
+ (org-log-states-order-reversed (goto-char (car (last positions))))
+ (t (goto-char (car positions))))))))
;;;###autoload
(defun org-clock-out (&optional switch-to-state fail-quietly at-time)
@@ -1561,11 +1629,14 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(message (concat "Clock stopped at %s after "
(org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s")
te (if remove " => LINE REMOVED" ""))
- (let ((h org-clock-out-hook))
+ (let ((h org-clock-out-hook)
+ (clock-drawer (org-clock-into-drawer)))
;; If a closing note needs to be stored in the drawer
;; where clocks are stored, let's temporarily disable
- ;; `org-clock-remove-empty-clock-drawer'
- (if (and (equal org-clock-into-drawer org-log-into-drawer)
+ ;; `org-clock-remove-empty-clock-drawer'.
+ (if (and clock-drawer
+ (not (stringp clock-drawer))
+ (org-log-into-drawer)
(eq org-log-done 'note)
org-clock-out-when-done)
(setq h (delq 'org-clock-remove-empty-clock-drawer h)))
@@ -1577,17 +1648,15 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(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))))
+ (let ((clock-drawer (org-log-into-drawer))
+ (end (save-excursion (org-end-of-subtree t t))))
(when clock-drawer
(save-excursion
(org-back-to-heading t)
(while (and (< (point) end)
(search-forward clock-drawer end t))
(goto-char (match-beginning 0))
- (org-remove-empty-drawer-at clock-drawer (point))
+ (org-remove-empty-drawer-at (point))
(forward-line 1))))))
(defun org-clock-timestamps-up (&optional n)
@@ -1651,12 +1720,13 @@ Optional argument N tells to change by that many units."
(setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(error "No active clock"))
- (save-excursion ; Do not replace this with `with-current-buffer'.
+ (save-excursion ; Do not replace this with `with-current-buffer'.
(org-no-warnings (set-buffer (org-clocking-buffer)))
(goto-char org-clock-marker)
- (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*"))
+ (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")
+ (line-beginning-position))
(progn (delete-region (1- (point-at-bol)) (point-at-eol))
- (org-remove-empty-drawer-at "LOGBOOK" (point)))
+ (org-remove-empty-drawer-at (point)))
(message "Clock gone, cancel the timer anyway")
(sit-for 2)))
(move-marker org-clock-marker nil)
@@ -1668,12 +1738,6 @@ Optional argument N tells to change by that many units."
(message "Clock canceled")
(run-hooks 'org-clock-cancel-hook))
-(defcustom org-clock-goto-before-context 2
- "Number of lines of context to display before currently clocked-in entry.
-This applies when using `org-clock-goto'."
- :group 'org-clock
- :type 'integer)
-
;;;###autoload
(defun org-clock-goto (&optional select)
"Go to the currently clocked-in entry, or to the most recently clocked one.
@@ -1709,9 +1773,22 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(defun org-clock-sum-today (&optional headline-filter)
"Sum the times for each subtree for today."
- (interactive)
(let ((range (org-clock-special-range 'today)))
- (org-clock-sum (car range) (cadr range) nil :org-clock-minutes-today)))
+ (org-clock-sum (car range) (cadr range)
+ headline-filter :org-clock-minutes-today)))
+
+(defun org-clock-sum-custom (&optional headline-filter range propname)
+ "Sum the times for each subtree for today."
+ (let ((r (or (and (symbolp range) (org-clock-special-range range))
+ (org-clock-special-range
+ (intern (completing-read
+ "Range: "
+ '("today" "yesterday" "thisweek" "lastweek"
+ "thismonth" "lastmonth" "thisyear" "lastyear"
+ "interactive")
+ nil t))))))
+ (org-clock-sum (car r) (cadr r)
+ headline-filter (or propname :org-clock-minutes-custom))))
;;;###autoload
(defun org-clock-sum (&optional tstart tend headline-filter propname)
@@ -1722,7 +1799,6 @@ 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.
PROPNAME lets you set a custom text property instead of :org-clock-minutes."
- (interactive)
(org-with-silent-modifications
(let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
org-clock-string
@@ -1780,6 +1856,8 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(save-excursion
(save-match-data (funcall headline-filter))))))
(setq level (- (match-end 1) (match-beginning 1)))
+ (when (>= level lmax)
+ (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
(when (or (> t1 0) (> (aref ltimes level) 0))
(when (or headline-included headline-forced)
(if headline-included
@@ -1812,59 +1890,79 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
org-clock-file-total-minutes)))
;;;###autoload
-(defun org-clock-display (&optional total-only)
+(defun org-clock-display (&optional arg)
"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.
+
+With one universal prefix argument, show the total time for
+today. With two universal prefix arguments, show the total time
+for a custom range, entered at the prompt. With three universal
+prefix arguments, show the total time in the echo area.
Use \\[org-clock-remove-overlays] to remove the subtree times."
- (interactive)
+ (interactive "P")
(org-clock-remove-overlays)
- (let (time h m p)
- (org-clock-sum)
- (unless total-only
+ (let* ((todayp (equal arg '(4)))
+ (customp (member arg '((16) today yesterday
+ thisweek lastweek thismonth
+ lastmonth thisyear lastyear
+ untilnow interactive)))
+ (prop (cond ((not arg) :org-clock-minutes-default)
+ (todayp :org-clock-minutes-today)
+ (customp :org-clock-minutes-custom)
+ (t :org-clock-minutes)))
+ time h m p)
+ (cond ((not arg) (org-clock-sum-custom
+ nil org-clock-display-default-range prop))
+ (todayp (org-clock-sum-today))
+ (customp (org-clock-sum-custom nil arg))
+ (t (org-clock-sum)))
+ (unless (eq arg '(64))
(save-excursion
(goto-char (point-min))
(while (or (and (equal (setq p (point)) (point-min))
- (get-text-property p :org-clock-minutes))
+ (get-text-property p prop))
(setq p (next-single-property-change
- (point) :org-clock-minutes)))
+ (point) prop)))
(goto-char p)
- (when (setq time (get-text-property p :org-clock-minutes))
- (org-clock-put-overlay time (funcall outline-level))))
+ (when (setq time (get-text-property p prop))
+ (org-clock-put-overlay time)))
(setq h (/ org-clock-file-total-minutes 60)
m (- org-clock-file-total-minutes (* 60 h)))
;; Arrange to remove the overlays upon next change.
(when org-remove-highlights-with-change
(org-add-hook 'before-change-functions 'org-clock-remove-overlays
nil 'local))))
- (message (concat "Total file time: "
- (org-minutes-to-clocksum-string org-clock-file-total-minutes)
- " (%d hours and %d minutes)") h m)))
+ (message (concat (format "Total file time%s: "
+ (cond (todayp " for today")
+ (customp " (custom)")
+ (t "")))
+ (org-minutes-to-clocksum-string
+ org-clock-file-total-minutes)
+ " (%d hours and %d minutes)")
+ h m)))
(defvar org-clock-overlays nil)
(make-variable-buffer-local 'org-clock-overlays)
-(defun org-clock-put-overlay (time &optional level)
+(defun org-clock-put-overlay (time)
"Put an overlays on the current line, displaying TIME.
-If LEVEL is given, prefix time with a corresponding number of stars.
This creates a new overlay and stores it in `org-clock-overlays', so that it
will be easy to remove."
- (let* ((l (if level (org-get-valid-level level 0) 0))
- ov tx)
+ (let (ov tx)
(beginning-of-line)
(when (looking-at org-complex-heading-regexp)
(goto-char (match-beginning 4)))
(setq ov (make-overlay (point) (point-at-eol))
tx (concat (buffer-substring-no-properties (point) (match-end 4))
- (make-string
- (max 0 (- (- 60 (current-column))
- (- (match-end 4) (match-beginning 4))
- (length (org-get-at-bol 'line-prefix)))) ?.)
- (org-add-props (concat (make-string l ?*) " "
- (org-minutes-to-clocksum-string time)
- (make-string (- 16 l) ?\ ))
- (list 'face 'org-clock-overlay))
+ (org-add-props
+ (make-string
+ (max 0 (- (- 60 (current-column))
+ (- (match-end 4) (match-beginning 4))
+ (length (org-get-at-bol 'line-prefix)))) ?·)
+ '(face shadow))
+ (org-add-props
+ (format " %9s " (org-minutes-to-clocksum-string time))
+ '(face org-clock-overlay))
""))
(if (not (featurep 'xemacs))
(overlay-put ov 'display tx)
@@ -1927,7 +2025,7 @@ fontified, and then returned."
(org-mode)
(org-create-dblock props)
(org-update-dblock)
- (font-lock-fontify-buffer)
+ (font-lock-ensure)
(forward-line 2)
(buffer-substring (point) (progn
(re-search-forward "^[ \t]*#\\+END" nil t)
@@ -2016,127 +2114,159 @@ buffer and update it."
(defun org-clock-special-range (key &optional time as-strings wstart mstart)
"Return two times bordering a special time range.
-Key is a symbol specifying the range and can be one of `today', `yesterday',
-`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'.
-By default, a week starts Monday 0:00 and ends Sunday 24:00.
-The range is determined relative to TIME, which defaults to current time.
-The return value is a cons cell with two internal times like the ones
-returned by `current time' or `encode-time'.
-If AS-STRINGS is non-nil, the returned times will be formatted strings.
-If WSTART is non-nil, use this number to specify the starting day of a
-week (monday is 1).
-If MSTART is non-nil, use this number to specify the starting day of a
-month (1 is the first day of the month).
-If you can combine both, the month starting day will have priority."
- (if (integerp key) (setq key (intern (number-to-string key))))
- (let* ((tm (decode-time (or time (current-time))))
- (s 0) (m (nth 1 tm)) (h (nth 2 tm))
- (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm))
+
+KEY is a symbol specifying the range and can be one of `today',
+`yesterday', `thisweek', `lastweek', `thismonth', `lastmonth',
+`thisyear', `lastyear' or `untilnow'. If set to `interactive',
+user is prompted for range boundaries. It can be a string or an
+integer.
+
+By default, a week starts Monday 0:00 and ends Sunday 24:00. The
+range is determined relative to TIME, which defaults to current
+time.
+
+The return value is a list containing two internal times, one for
+the beginning of the range and one for its end, like the ones
+returned by `current time' or `encode-time' and a string used to
+display information. If AS-STRINGS is non-nil, the returned
+times will be formatted strings.
+
+If WSTART is non-nil, use this number to specify the starting day
+of a week (monday is 1). If MSTART is non-nil, use this number
+to specify the starting day of a month (1 is the first day of the
+month). If you can combine both, the month starting day will
+have priority."
+ (let* ((tm (decode-time time))
+ (m (nth 1 tm))
+ (h (nth 2 tm))
+ (d (nth 3 tm))
+ (month (nth 4 tm))
+ (y (nth 5 tm))
(dow (nth 6 tm))
- (ws (or wstart 1))
- (ms (or mstart 1))
- (skey (symbol-name key))
+ (skey (format "%s" key))
(shift 0)
- (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)
+ (q (cond ((>= month 10) 4)
+ ((>= month 7) 3)
+ ((>= month 4) 2)
+ (t 1)))
+ m1 h1 d1 month1 y1 shiftedy shiftedm shiftedq)
(cond
- ((string-match "^[0-9]+$" skey)
- (setq y (string-to-number skey) m 1 d 1 key 'year))
- ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)$" skey)
+ ((string-match "\\`[0-9]+\\'" skey)
+ (setq y (string-to-number skey) month 1 d 1 key 'year))
+ ((string-match "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)\\'" skey)
(setq y (string-to-number (match-string 1 skey))
month (string-to-number (match-string 2 skey))
- d 1 key 'month))
- ((string-match "^\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)$" skey)
+ d 1
+ key 'month))
+ ((string-match "\\`\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)\\'" skey)
(require 'cal-iso)
- (setq y (string-to-number (match-string 1 skey))
- w (string-to-number (match-string 2 skey)))
- (setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (list w 1 y))))
- (setq d (nth 1 date) month (car date) y (nth 2 date)
- dow 1
- key 'week))
- ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
+ (let ((date (calendar-gregorian-from-absolute
+ (calendar-iso-to-absolute
+ (list (string-to-number (match-string 2 skey))
+ 1
+ (string-to-number (match-string 1 skey)))))))
+ (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)
+ (let ((date (calendar-gregorian-from-absolute
+ (calendar-iso-to-absolute
+ (org-quarter-to-date
+ (string-to-number (match-string 2 skey))
+ (string-to-number (match-string 1 skey)))))))
+ (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))
d (string-to-number (match-string 3 skey))
key 'day))
- ((string-match "\\([-+][0-9]+\\)$" skey)
+ ((string-match "\\([-+][0-9]+\\)\\'" skey)
(setq shift (string-to-number (match-string 1 skey))
- key (intern (substring skey 0 (match-beginning 1))))
- (if (and (memq key '(quarter thisq)) (> shift 0))
- (error "Looking forward with quarters isn't implemented"))))
-
+ key (intern (substring skey 0 (match-beginning 1))))
+ (when (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))
- ((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))
- ((memq key '(week thisweek))
- (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))
- m 0 h 0 d (- d diff) d1 (+ 7 d)))
- ((memq key '(month thismonth))
- (setq d (or ms 1) h 0 m 0 d1 (or ms 1)
- month (+ month shift) month1 (1+ month) h1 0 m1 0))
- ((memq key '(quarter thisq))
- ;; Compute if this shift remains in this year. If not, compute
- ;; how many years and quarters we have to shift (via floor*) and
- ;; compute the shifted years, months and quarters.
- (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 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))))
- ((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)))
- (setq ts (encode-time s m h d month y)
- te (encode-time (or s1 s) (or m1 m) (or h1 h)
- (or d1 d) (or month1 month) (or y1 y)))
- (setq fm (cdr org-time-stamp-formats))
- (cond
- ((memq key '(day today))
- (setq txt (format-time-string "%A, %B %d, %Y" ts)))
- ((memq key '(week thisweek))
- (setq txt (format-time-string "week %G-W%V" ts)))
- ((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)))
- ((memq key '(quarter thisq))
- (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))))
- (if as-strings
- (list (format-time-string fm ts) (format-time-string fm te) txt)
- (list ts te txt))))
+ (case key
+ (yesterday (setq key 'today shift -1))
+ (lastweek (setq key 'week shift -1))
+ (lastmonth (setq key 'month shift -1))
+ (lastyear (setq key 'year shift -1))
+ (lastq (setq key 'quarter shift -1))))
+ ;; Prepare start and end times depending on KEY's type.
+ (case key
+ ((day today) (setq m 0 h 0 h1 24 d (+ d shift)))
+ ((week thisweek)
+ (let* ((ws (or wstart 1))
+ (diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))))
+ (setq m 0 h 0 d (- d diff) d1 (+ 7 d))))
+ ((month thismonth)
+ (setq h 0 m 0 d (or mstart 1) month (+ month shift) month1 (1+ month)))
+ ((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.
+ (let* ((interval (* -1 (+ (- q 1) shift)))
+ ;; Set tmp to ((years to shift) (quarters to shift)).
+ (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 m 0 h 0 d 1 month shiftedm month1 (+ 3 shiftedm) y shiftedy))
+ ((> (+ q shift) 0) ; Shift is within this year.
+ (setq shiftedq (+ q shift))
+ (setq shiftedy y)
+ (let ((qshift (* 3 (1- (+ q shift)))))
+ (setq m 0 h 0 d 1 month (+ 1 qshift) month1 (+ 4 qshift))))))
+ ((year thisyear)
+ (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
+ ((interactive untilnow)) ; Special cases, ignore them.
+ (t (user-error "No such time block %s" key)))
+ ;; Format start and end times according to AS-STRINGS.
+ (let* ((start (case key
+ (interactive (org-read-date nil t nil "Range start? "))
+ (untilnow org-clock--oldest-date)
+ (t (encode-time 0 m h d month y))))
+ (end (case key
+ (interactive (org-read-date nil t nil "Range end? "))
+ (untilnow (current-time))
+ (t (encode-time 0
+ (or m1 m)
+ (or h1 h)
+ (or d1 d)
+ (or month1 month)
+ (or y1 y)))))
+ (text
+ (case key
+ ((day today) (format-time-string "%A, %B %d, %Y" start))
+ ((week thisweek) (format-time-string "week %G-W%V" start))
+ ((month thismonth) (format-time-string "%B %Y" start))
+ ((year thisyear) (format-time-string "the year %Y" start))
+ ((quarter thisq)
+ (concat (org-count-quarter shiftedq)
+ " quarter of " (number-to-string shiftedy)))
+ (interactive "(Range interactively set)")
+ (untilnow "now"))))
+ (if (not as-strings) (list start end text)
+ (let ((f (cdr org-time-stamp-formats)))
+ (list (format-time-string f start)
+ (format-time-string f end)
+ text))))))
(defun org-count-quarter (n)
(cond
@@ -2192,7 +2322,7 @@ the currently selected interval size."
((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))))
+ (calendar-iso-to-absolute (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)))))
@@ -2209,7 +2339,7 @@ the currently selected interval size."
y (- y 1))
())
(setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y))))
+ (calendar-iso-to-absolute (org-quarter-to-date (+ mw n) y))))
(setq ins (format-time-string
(concat (number-to-string y) "-Q" (number-to-string (+ mw n)))
(encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
@@ -2336,6 +2466,7 @@ from the dynamic block definition."
org-clock-clocktable-language-setup))
(multifile (plist-get params :multifile))
(block (plist-get params :block))
+ (sort (plist-get params :sort))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
(header (plist-get params :header))
@@ -2542,6 +2673,11 @@ from the dynamic block definition."
(when org-hide-emphasis-markers
;; we need to align a second time
(org-table-align))
+ (when sort
+ (save-excursion
+ (org-table-goto-line 3)
+ (org-table-goto-column (car sort))
+ (org-table-sort-lines nil (cdr sort))))
(when recalc
(if (eq formula '%)
(save-excursion
@@ -2556,10 +2692,10 @@ from the dynamic block definition."
total-time))
(defun org-clocktable-indent-string (level)
+ "Return indentation string according to LEVEL.
+LEVEL is an integer. Indent by two spaces per level above 1."
(if (= level 1) ""
- (let ((str " "))
- (dotimes (k (1- level) str)
- (setq str (concat "\\emsp" str))))))
+ (concat "\\_" (make-string (* 2 (1- level)) ?\s))))
(defun org-clocktable-steps (params)
"Step through the range to make a number of clock tables."
@@ -2670,10 +2806,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(when (and te (listp te))
(setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te))))
;; Now the times are strings we can parse.
- (if ts (setq ts (org-float-time
- (seconds-to-time (org-matcher-time ts)))))
- (if te (setq te (org-float-time
- (seconds-to-time (org-matcher-time te)))))
+ (if ts (setq ts (org-matcher-time ts)))
+ (if te (setq te (org-matcher-time te)))
(save-excursion
(org-clock-sum ts te
(unless (null matcher)
@@ -2813,8 +2947,8 @@ The details of what will be saved are regulated by the variable
(delete-region (point-min) (point-max))
;;Store clock
(insert (format ";; org-persist.el - %s at %s\n"
- system-name (format-time-string
- (cdr org-time-stamp-formats))))
+ (system-name) (format-time-string
+ (cdr org-time-stamp-formats))))
(if (and (memq org-clock-persist '(t clock))
(setq b (org-clocking-buffer))
(setq b (or (buffer-base-buffer b) b))