diff options
Diffstat (limited to 'lisp/org-clock.el')
| -rw-r--r-- | lisp/org-clock.el | 740 |
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)) |