X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8678d9e413593b0abab296551a20589745c459da..63aa098259339e924d8a7d40c59a34e579132af6:/lisp/org/org-clock.el diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 4e30dd90d8..e8ced67e69 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1,11 +1,10 @@ ;;; org-clock.el --- The time clocking code for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004-2012 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -27,7 +26,7 @@ ;; This file contains the time clocking code for Org-mode -(require 'org) +(require 'org-exp) ;;; Code: (eval-when-compile @@ -35,7 +34,10 @@ (declare-function calendar-absolute-from-iso "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)) (defvar org-time-stamp-formats) +(defvar org-ts-what) +(defvar org-frame-title-format-backup frame-title-format) (defgroup org-clock nil "Options concerning clocking working time in Org-mode." @@ -62,6 +64,22 @@ which see." (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. @@ -125,7 +143,7 @@ The function is called with point at the beginning of the headline." :type 'function) (defcustom org-clock-string-limit 0 - "Maximum length of clock strings in the modeline. 0 means no limit." + "Maximum length of clock strings in the mode line. 0 means no limit." :group 'org-clock :type 'integer) @@ -183,8 +201,11 @@ file name play this sound file. If not possible, fall back to beep" (const :tag "Standard beep" t) (file :tag "Play sound file"))) -(defcustom org-clock-modeline-total 'auto - "Default setting for the time included for the modeline clock. +(define-obsolete-variable-alias 'org-clock-modeline-total + 'org-clock-mode-line-total "24.3") + +(defcustom org-clock-mode-line-total 'auto + "Default setting for the time included for the mode line clock. This can be overruled locally using the CLOCK_MODELINE_TOTAL property. Allowed values are: @@ -201,13 +222,15 @@ auto Automatically, either `all', or `repeat' for repeating tasks" (const :tag "All task time" all) (const :tag "Automatically, `all' or since `repeat'" auto))) -(defcustom org-task-overrun-text nil - "The extra modeline text that should indicate that the clock is overrun. +(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) +(defcustom org-clock-task-overrun-text nil + "Extra mode line text to indicate that the clock is overrun. The can be nil to indicate that instead of adding text, the clock time should get a different face (`org-mode-line-clock-overrun'). When this is a string, it is prepended to the clock string as an indication, also using the face `org-mode-line-clock-overrun'." :group 'org-clock + :version "24.1" :type '(choice (const :tag "Just mark the time string" nil) (string :tag "Text to prepend"))) @@ -229,6 +252,7 @@ string as argument." (defcustom org-clocktable-defaults (list :maxlevel 2 + :lang org-export-default-language :scope 'file :block nil :tstart nil @@ -248,14 +272,27 @@ string as argument." :formatter nil) "Default properties for clock tables." :group 'org-clock + :version "24.1" :type 'plist) (defcustom org-clock-clocktable-formatter 'org-clocktable-write-default "Function to turn clocking data into a table. For more information, see `org-clocktable-write-default'." :group 'org-clocktable + :version "24.1" :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 + :version "24.1" + :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 @@ -281,13 +318,62 @@ play with them." (defcustom org-clock-report-include-clocking-task nil "When non-nil, include the current clocking task time in clock reports." :group 'org-clock + :version "24.1" :type 'boolean) (defcustom org-clock-resolve-expert nil "Non-nil means do not show the splash buffer with the clock resolver." :group 'org-clock + :version "24.1" + :type 'boolean) + +(defcustom org-clock-continuously nil + "Non-nil means to start clocking from the last clock-out time, if any." + :type 'boolean + :version "24.1" + :group 'org-clock) + +(defcustom org-clock-total-time-cell-format "*%s*" + "Format string for the total time cells." + :group 'org-clock + :version "24.1" + :type 'boolean) + +(defcustom org-clock-file-time-cell-format "*%s*" + "Format string for the file time cells." + :group 'org-clock + :version "24.1" :type 'boolean) +(defcustom org-clock-clocked-in-display 'mode-line + "When clocked in for a task, org-mode can display the current +task and accumulated time in the mode line and/or frame title. +Allowed values are: + +both displays in both mode line and frame title +mode-line displays only in mode line (default) +frame-title displays only in frame title +nil current clock is not displayed" + :group 'org-clock + :type '(choice + (const :tag "Mode line" mode-line) + (const :tag "Frame title" frame-title) + (const :tag "Both" both) + (const :tag "None" nil))) + +(defcustom org-clock-frame-title-format '(t org-mode-line-string) + "The value for `frame-title-format' when clocking in. + +When `org-clock-clocked-in-display' is set to 'frame-title +or 'both, clocking in will replace `frame-title-format' with +this value. Clocking out will restore `frame-title-format'. + +`org-frame-title-string' is a format string using the same +specifications than `frame-title-format', which see." + :version "24.1" + :group 'org-clock + :type 'sexp) + (defvar org-clock-in-prepare-hook nil "Hook run when preparing the clock. This hook is run before anything happens to the task that @@ -387,6 +473,9 @@ of a different 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) @@ -419,6 +508,7 @@ of a different task.") (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)) @@ -441,13 +531,11 @@ pointing to it." (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 @@ -458,7 +546,7 @@ pointing to it." (insert (format "[%c] %-15s %s\n" i cat task)) (cons i marker))))) -(defvar org-task-overrun nil +(defvar org-clock-task-overrun nil "Internal flag indicating if the clock has overrun the planned time.") (defvar org-clock-update-period 60 "Number of seconds between mode line clock string updates.") @@ -473,17 +561,17 @@ If not, show simply the clocked time like 01:50." (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 (org-propertize (format org-time-clocksum-format h m) - 'face (if (and org-task-overrun (not org-task-overrun-text)) + 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text)) 'org-mode-line-clock-overrun 'org-mode-line-clock))) (effort-str (format org-time-clocksum-format effort-h effort-m)) (clockstr (org-propertize - (concat "[%s/" effort-str + (concat " [%s/" effort-str "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") 'face 'org-mode-line-clock))) (format clockstr work-done-str)) @@ -495,7 +583,7 @@ If not, show simply the clocked time like 01:50." (defun org-clock-update-mode-line () (if org-clock-effort (org-clock-notify-once-if-expired) - (setq org-task-overrun nil)) + (setq org-clock-task-overrun nil)) (setq org-mode-line-string (org-propertize (let ((clock-string (org-clock-get-clock-string)) @@ -507,12 +595,11 @@ If not, show simply the clocked time like 01:50." 'help-echo (concat help-text ": " org-clock-heading)) (org-propertize clock-string 'help-echo help-text))) 'local-map org-clock-mode-line-map - 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight) - )) - (if (and org-task-overrun org-task-overrun-text) + 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight))) + (if (and org-clock-task-overrun org-clock-task-overrun-text) (setq org-mode-line-string (concat (org-propertize - org-task-overrun-text + org-clock-task-overrun-text 'face 'org-mode-line-clock-overrun) org-mode-line-string))) (force-mode-line-update)) @@ -526,39 +613,40 @@ previous clocking intervals." (+ currently-clocked-time (or org-clock-total-time 0)))) (defun org-clock-modify-effort-estimate (&optional value) - "Add to or set the effort estimate of the item currently being clocked. + "Add to or set the effort estimate of the item currently being clocked. VALUE can be a number of minutes, or a string with format hh:mm or mm. When the string starts with a + or a - sign, the current value of the effort property will be changed by that amount. This will update the \"Effort\" property of currently clocked item, and the mode line." - (interactive) - (when (org-clock-is-active) - (let ((current org-clock-effort) sign) - (unless value - ;; Prompt user for a value or a change - (setq value - (read-string - (format "Set effort (hh:mm or mm%s): " - (if current - (format ", prefix + to add to %s" org-clock-effort) - ""))))) - (when (stringp value) - ;; 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) - value (substring value 1)) - (setq current 0)) - (setq value (org-hh:mm-string-to-minutes value)) - (if (equal ?- sign) - (setq value (- current value)) - (if (equal ?+ sign) (setq value (+ current value))))) - (setq value (max 0 value) - org-clock-effort (org-minutes-to-hh:mm-string value)) - (org-entry-put org-clock-marker "Effort" org-clock-effort) - (org-clock-update-mode-line) - (message "Effort is now %s" org-clock-effort)))) + (interactive) + (if (org-clock-is-active) + (let ((current org-clock-effort) sign) + (unless value + ;; Prompt user for a value or a change + (setq value + (read-string + (format "Set effort (hh:mm or mm%s): " + (if current + (format ", prefix + to add to %s" org-clock-effort) + ""))))) + (when (stringp value) + ;; A string. See if it is a delta + (setq sign (string-to-char value)) + (if (member sign '(?- ?+)) + (setq current (org-duration-string-to-minutes current) + value (substring value 1)) + (setq current 0)) + (setq value (org-duration-string-to-minutes value)) + (if (equal ?- sign) + (setq value (- current value)) + (if (equal ?+ sign) (setq value (+ current value))))) + (setq value (max 0 value) + org-clock-effort (org-minutes-to-hh:mm-string value)) + (org-entry-put org-clock-marker "Effort" org-clock-effort) + (org-clock-update-mode-line) + (message "Effort is now %s" org-clock-effort)) + (message "Clock is not currently active"))) (defvar org-clock-notification-was-shown nil "Shows if we have shown notification already.") @@ -567,9 +655,9 @@ the mode line." "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 (setq org-clock-task-overrun (if (or (null effort-in-minutes) (zerop effort-in-minutes)) nil (>= clocked-time effort-in-minutes))) @@ -594,15 +682,14 @@ use libnotify if available, or fall back on a message." ((stringp org-show-notification-handler) (start-process "emacs-timer-notification" nil org-show-notification-handler notification)) - ((featurep 'notifications) - (require 'notifications) + ((fboundp 'notifications-notify) (notifications-notify :title "Org-mode message" :body notification ;; FIXME how to link to the Org icon? ;; :app-icon "~/.emacs.d/icons/mail.png" :urgency 'low)) - ((org-program-exists "notify-send") + ((executable-find "notify-send") (start-process "emacs-timer-notification" nil "notify-send" notification)) ;; Maybe the handler will send a message, so only use message as @@ -618,20 +705,15 @@ Use alsa's aplay tool if available." ((stringp org-clock-sound) (let ((file (expand-file-name org-clock-sound))) (if (file-exists-p file) - (if (org-program-exists "aplay") + (if (executable-find "aplay") (start-process "org-clock-play-notification" nil "aplay" file) (condition-case nil (play-sound-file file) (error (beep t) (beep t))))))))) -(defun org-program-exists (program-name) - "Checks whenever we can locate program and launch it." - (if (eq system-type 'gnu/linux) - (= 0 (call-process "which" nil nil nil program-name)))) - (defvar org-clock-mode-line-entry nil - "Information for the modeline about the running clock.") + "Information for the mode line about the running clock.") (defun org-find-open-clocks (file) "Search through the given file and find all open clocks." @@ -660,7 +742,7 @@ Use alsa's aplay tool if available." (goto-char (car ,clock)) (beginning-of-line) ,@forms)))) - +(def-edebug-spec org-with-clock-position (form body)) (put 'org-with-clock-position 'lisp-indent-function 1) (defmacro org-with-clock (clock &rest forms) @@ -676,7 +758,7 @@ This macro also protects the current active clock from being altered." (outline-back-to-heading t) (point-marker)))) ,@forms))) - +(def-edebug-spec org-with-clock (form body)) (put 'org-with-clock 'lisp-indent-function 1) (defsubst org-clock-clock-in (clock &optional resume start-time) @@ -691,9 +773,9 @@ If necessary, clock-out of the currently active clock." (let ((temp (copy-marker (car clock) (marker-insertion-type (car clock))))) (if (org-is-active-clock clock) - (org-clock-out fail-quietly at-time) + (org-clock-out nil fail-quietly at-time) (org-with-clock clock - (org-clock-out fail-quietly at-time))) + (org-clock-out nil fail-quietly at-time))) (setcar clock temp))) (defsubst org-clock-clock-cancel (clock) @@ -746,7 +828,8 @@ If necessary, clock-out of the currently active clock." (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")) @@ -882,6 +965,7 @@ to be CLOCKED OUT."))) (not (memq ch '(?K ?G ?S ?C)))) fail-quietly))))) +;;;###autoload (defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid) "Resolve all currently open org-mode clocks. If `only-dangling-p' is non-nil, only ask to resolve dangling @@ -895,18 +979,18 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (let ((dangling (or (not (org-clock-is-active)) (/= (car clock) org-clock-marker)))) (if (or (not only-dangling-p) dangling) - (org-clock-resolve - clock - (or prompt-fn - (function - (lambda (clock) - (format - "Dangling clock started %d mins ago" - (floor - (/ (- (org-float-time (current-time)) - (org-float-time (cdr clock))) 60)))))) - (or last-valid - (cdr clock))))))))))) + (org-clock-resolve + clock + (or prompt-fn + (function + (lambda (clock) + (format + "Dangling clock started %d mins ago" + (floor + (/ (- (org-float-time (current-time)) + (org-float-time (cdr clock))) 60)))))) + (or last-valid + (cdr clock))))))))))) (defun org-emacs-idle-seconds () "Return the current Emacs idle time in seconds, or nil if not idle." @@ -919,6 +1003,13 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling "Return the current Mac idle time in seconds." (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'"))) +(defvar org-x11idle-exists-p + ;; Check that x11idle exists + (and (eq window-system 'x) + (eq (call-process-shell-command "command" nil nil nil "-v" "x11idle") 0) + ;; Check that x11idle can retrieve the idle time + (eq (call-process-shell-command "x11idle" nil nil nil) 0))) + (defun org-x11-idle-seconds () "Return the current X11 idle time in seconds." (/ (string-to-number (shell-command-to-string "x11idle")) 1000)) @@ -929,7 +1020,7 @@ This routine returns a floating point number." (cond ((eq system-type 'darwin) (org-mac-idle-seconds)) - ((eq window-system 'x) + ((and (eq window-system 'x) org-x11idle-exists-p) (org-x11-idle-seconds)) (t (org-emacs-idle-seconds)))) @@ -961,15 +1052,30 @@ so long." 60.0)))) org-clock-user-idle-start))))) +(defvar org-clock-current-task nil + "Task currently clocked in.") +(defun org-clock-set-current () + "Set `org-clock-current-task' to the task currently clocked in." + (setq org-clock-current-task (nth 4 (org-heading-components)))) + +(defun org-clock-delete-current () + "Reset `org-clock-current-task' to nil." + (setq org-clock-current-task nil)) + +(defvar org-clock-out-time nil) ; store the time of the last clock-out + +;;;###autoload (defun org-clock-in (&optional select start-time) "Start the clock on the current item. If necessary, clock-out of the currently active clock. -With a prefix argument SELECT (\\[universal-argument]), offer a list of \ -recently clocked tasks to -clock into. When SELECT is \\[universal-argument] \\[universal-argument], \ -clock into the current task and mark -is as the default task, a special task that will always be offered in -the clocking selection, associated with the letter `d'." +With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked +tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task +and mark it as the default task, a special task that will always be offered +in the clocking selection, associated with the letter `d'. +When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \ +clock in by using the last clock-out +time as the start time \(see `org-clock-continuously' to +make this the default behavior.)" (interactive "P") (setq org-clock-notification-was-shown nil) (catch 'abort @@ -977,7 +1083,8 @@ the clocking selection, associated with the letter `d'." (org-clocking-p))) ts selected-task target-pos (msg-extra "") (leftover (and (not org-clock-resolving-clocks) - org-clock-leftover-time))) + org-clock-leftover-time))) + (when (and org-clock-auto-clock-resolution (or (not interrupting) (eq t org-clock-auto-clock-resolution)) @@ -986,11 +1093,22 @@ the clocking selection, associated with the letter `d'." (setq org-clock-leftover-time nil) (let ((org-clock-clocking-in t)) (org-resolve-clocks))) ; check if any clocks are dangling + + (when (equal select '(64)) + ;; Set start-time to `org-clock-out-time' + (let ((org-clock-continuously t)) + (org-clock-in nil org-clock-out-time))) + (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. @@ -1005,25 +1123,21 @@ the clocking selection, associated with the letter `d'." (= (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 (marker-position org-clock-marker) (marker-buffer org-clock-marker)) (let ((org-clock-clocking-in t)) - (org-clock-out t))) - - (when (equal select '(16)) - ;; Mark as default clocking task - (org-clock-mark-default-task)) + (org-clock-out nil t))) ;; Clock in at which position? (setq target-pos - (if (and (eobp) (not (org-on-heading-p))) + (if (and (eobp) (not (org-at-heading-p))) (point-at-bol 0) (point))) - (run-hooks 'org-clock-in-prepare-hook) (save-excursion (when (and selected-task (marker-buffer selected-task)) ;; There is a selected task, move to the correct buffer @@ -1037,7 +1151,13 @@ the clocking selection, associated with the letter `d'." (goto-char target-pos) (org-back-to-heading t) (or interrupting (move-marker org-clock-interrupted-task nil)) - (org-clock-history-push) + (save-excursion + (forward-char) ;; make sure the marker is not at the + ;; beginning of the heading, since the + ;; user is liking to insert stuff here + ;; manually + (run-hooks 'org-clock-in-prepare-hook) + (org-clock-history-push)) (org-clock-set-current) (cond ((functionp org-clock-in-switch-to-state) (looking-at org-complex-heading-regexp) @@ -1045,7 +1165,7 @@ the clocking selection, associated with the letter `d'." (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))) @@ -1058,7 +1178,8 @@ the clocking selection, associated with the letter `d'." (cond ((and org-clock-heading-function (functionp org-clock-heading-function)) (funcall org-clock-heading-function)) - ((looking-at org-complex-heading-regexp) + ((and (looking-at org-complex-heading-regexp) + (match-string 4)) (replace-regexp-in-string "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" (match-string 4))) @@ -1069,9 +1190,9 @@ the clocking selection, associated with the letter `d'." (cond ((and org-clock-in-resume (looking-at - (concat "^[ \t]* " org-clock-string + (concat "^[ \t]*" org-clock-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" - " +\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) + " *\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) (message "Matched %s" (match-string 1)) (setq ts (concat "[" (match-string 1) "]")) (goto-char (match-end 1)) @@ -1091,7 +1212,7 @@ the clocking selection, associated with the letter `d'." (t (insert-before-markers "\n") (backward-char 1) - (org-indent-line-function) + (org-indent-line) (when (and (save-excursion (end-of-line 0) (org-in-item-p))) @@ -1102,7 +1223,8 @@ the clocking selection, associated with the letter `d'." (setq org-clock-total-time (org-clock-sum-current-item (org-clock-get-sum-start))) (setq org-clock-start-time - (or (and leftover + (or (and org-clock-continuously org-clock-out-time) + (and leftover (y-or-n-p (format "You stopped another clock %d mins ago; start this one from then? " @@ -1118,18 +1240,26 @@ the clocking selection, associated with the letter `d'." (save-excursion (org-back-to-heading t) (point)) (buffer-base-buffer)) (setq org-clock-has-been-used t) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-mode-line-string)))) + ;; add to mode line + (when (or (eq org-clock-clocked-in-display 'mode-line) + (eq org-clock-clocked-in-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-mode-line-string))))) + ;; add to frame title + (when (or (eq org-clock-clocked-in-display 'frame-title) + (eq org-clock-clocked-in-display 'both)) + (setq frame-title-format org-clock-frame-title-format)) (org-clock-update-mode-line) (when org-clock-mode-line-timer (cancel-timer org-clock-mode-line-timer) (setq org-clock-mode-line-timer nil)) - (setq org-clock-mode-line-timer - (run-with-timer org-clock-update-period - org-clock-update-period - 'org-clock-update-mode-line)) + (when org-clock-clocked-in-display + (setq org-clock-mode-line-timer + (run-with-timer org-clock-update-period + org-clock-update-period + 'org-clock-update-mode-line))) (when org-clock-idle-timer (cancel-timer org-clock-idle-timer) (setq org-clock-idle-timer nil)) @@ -1138,15 +1268,40 @@ the clocking selection, associated with the letter `d'." (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)) +;;;###autoload +(defun org-clock-in-last (&optional arg) + "Clock in the last closed clocked item. +When already clocking in, send an warning. +With a universal prefix argument, select the task you want to +clock in from the last clocked in tasks. +With two universal prefix arguments, start clocking using the +last clock-out time, if any. +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)) + (let ((start-time (if (or org-clock-continuously (equal arg '(16))) + (or org-clock-out-time (current-time)) + (current-time)))) + (if (null org-clock-history) + (message "No last clock") + (let ((org-clock-in-switch-to-state + (if (and (not org-clock-current-task) (equal arg '(64))) + (completing-read "Switch to state: " + (and org-clock-history + (with-current-buffer + (marker-buffer (car org-clock-history)) + org-todo-keywords-1))) + org-clock-in-switch-to-state)) + (already-clocking org-clock-current-task)) + (org-clock-clock-in (list (car org-clock-history)) nil start-time) + (or already-clocking + ;; Don't display a message if we are already clocking in + (message "Clocking back: %s (in %s)" + org-clock-current-task + (buffer-name (marker-buffer org-clock-marker))))))))) (defun org-clock-mark-default-task () "Mark current task as default task." @@ -1161,10 +1316,10 @@ the clocking selection, associated with the letter `d'." This is for the currently running clock as it is displayed in the mode line. This function looks at the properties LAST_REPEAT and in particular CLOCK_MODELINE_TOTAL and the -corresponding variable `org-clock-modeline-total' and then +corresponding variable `org-clock-mode-line-total' and then decides which time to use." (let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL") - (symbol-name org-clock-modeline-total))) + (symbol-name org-clock-mode-line-total))) (lr (org-entry-get nil "LAST_REPEAT"))) (cond ((equal cmt "current") @@ -1197,22 +1352,23 @@ 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 ((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 - (concat "^[ \t]* " org-clock-string + (concat "^[ \t]*" org-clock-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" - " +\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$") + " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$") end t)) (beginning-of-line 1) (throw 'exit t)) @@ -1239,14 +1395,17 @@ line and position cursor in that line." (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) (goto-char first) (insert ":" drawer ":\n") (beginning-of-line 0) - (org-indent-line-function) + (org-indent-line) (org-flag-drawer t) (beginning-of-line 2) (or org-log-states-order-reversed @@ -1266,28 +1425,42 @@ line and position cursor in that line." (< org-clock-into-drawer 2))) (insert ":" drawer ":\n:END:\n") (beginning-of-line -1) - (org-indent-line-function) + (org-indent-line) (org-flag-drawer t) (beginning-of-line 2) - (org-indent-line-function) + (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)))))))) -(defun org-clock-out (&optional fail-quietly at-time) +;;;###autoload +(defun org-clock-out (&optional switch-to-state fail-quietly at-time) "Stop the currently running clock. -If there is no running clock, throw an error, unless FAIL-QUIETLY is set." - (interactive) +Throw an error if there is no running clock and FAIL-QUIETLY is nil. +With a universal prefix, prompt for a state to switch the clocked out task +to, overriding the existing value of `org-clock-out-switch-to-state'." + (interactive "P") (catch 'exit (when (not (org-clocking-p)) (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (force-mode-line-update) - (if fail-quietly (throw 'exit t) (error "No active clock"))) - (let (ts te s h m remove) + (if fail-quietly (throw 'exit t) (user-error "No active clock"))) + (let ((org-clock-out-switch-to-state + (if switch-to-state + (completing-read "Switch to state: " + (with-current-buffer + (marker-buffer org-clock-marker) + org-todo-keywords-1) + nil t "DONE") + org-clock-out-switch-to-state)) + (now (current-time)) + ts te s h m remove) + (setq org-clock-out-time now) (save-excursion ; Do not replace this with `with-current-buffer'. - (with-no-warnings (set-buffer (org-clocking-buffer))) + (org-no-warnings (set-buffer (org-clocking-buffer))) (save-restriction (widen) (goto-char org-clock-marker) @@ -1299,8 +1472,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (goto-char (match-end 0)) (delete-region (point) (point-at-eol)) (insert "--") - (setq te (org-insert-time-stamp (or at-time (current-time)) - 'with-hm 'inactive)) + (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te))) (org-float-time (apply 'encode-time (org-parse-time-string ts)))) h (floor (/ s 3600)) @@ -1327,6 +1499,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (setq org-clock-idle-timer nil)) (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (when org-clock-out-switch-to-state (save-excursion (org-back-to-heading t) @@ -1339,7 +1512,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (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)))))) @@ -1347,30 +1520,108 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m (if remove " => LINE REMOVED" "")) (run-hooks 'org-clock-out-hook) - (org-clock-delete-current)))))) + (unless (org-clocking-p) + (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 (and (< (point) end) + (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))))))) + +;;;###autoload (defun org-clock-cancel () "Cancel the running clock by removing the start timestamp." (interactive) (when (not (org-clocking-p)) (setq global-mode-string - (delq 'org-mode-line-string global-mode-string)) + (delq 'org-mode-line-string global-mode-string)) + (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'. - (with-no-warnings (set-buffer (org-clocking-buffer))) + (org-no-warnings (set-buffer (org-clocking-buffer))) (goto-char org-clock-marker) - (delete-region (1- (point-at-bol)) (point-at-eol)) - ;; Just in case, remove any empty LOGBOOK left over - (org-remove-empty-drawer-at "LOGBOOK" (point))) + (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")) + (progn (delete-region (1- (point-at-bol)) (point-at-eol)) + (org-remove-empty-drawer-at "LOGBOOK" (point))) + (message "Clock gone, cancel the timer anyway") + (sit-for 2))) (move-marker org-clock-marker nil) (move-marker org-clock-hd-marker nil) (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (force-mode-line-update) (message "Clock canceled") (run-hooks 'org-clock-cancel-hook)) +;;;###autoload (defun org-clock-goto (&optional select) "Go to the currently clocked-in entry, or to the most recently clocked one. With prefix arg SELECT, offer recently clocked tasks for selection." @@ -1387,7 +1638,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (setq recent t) (car org-clock-history)) (t (error "No active or recent clock task"))))) - (switch-to-buffer (marker-buffer m)) + (org-pop-to-buffer-same-window (marker-buffer m)) (if (or (< m (point-min)) (> m (point-max))) (widen)) (goto-char m) (org-show-entry) @@ -1403,13 +1654,21 @@ With prefix arg SELECT, offer recently clocked tasks for selection." "Holds the file total time in minutes, after a call to `org-clock-sum'.") (make-variable-buffer-local 'org-clock-file-total-minutes) -(defun org-clock-sum (&optional tstart tend headline-filter) +(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))) + +;;;###autoload +(defun org-clock-sum (&optional tstart tend headline-filter propname) "Sum the times for each subtree. Puts the resulting times in minutes as a text property on each headline. -TSTART and TEND can mark a time range to be considered. 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." +TSTART and TEND can mark a time range to be considered. +HEADLINE-FILTER is a zero-arg function that, if specified, is called for +each headline in the time range with point at the headline. Headlines for +which HEADLINE-FILTER returns nil are excluded from the clock summation. +PROPNAME lets you set a custom text property instead of :org-clock-minutes." (interactive) (let* ((bmp (buffer-modified-p)) (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" @@ -1426,7 +1685,7 @@ nil are excluded from the clock summation." (if (consp tstart) (setq tstart (org-float-time tstart))) (if (consp tend) (setq tend (org-float-time tend))) (remove-text-properties (point-min) (point-max) - '(:org-clock-minutes t + `(,(or propname :org-clock-minutes) t :org-clock-force-headline-inclusion t)) (save-excursion (goto-char (point-max)) @@ -1475,7 +1734,8 @@ nil are excluded from the clock summation." (aset ltimes l (+ (aref ltimes l) t1)))) (setq time (aref ltimes level)) (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) :org-clock-minutes time) + (put-text-property (point) (point-at-eol) + (or propname :org-clock-minutes) time) (if headline-filter (save-excursion (save-match-data @@ -1499,10 +1759,13 @@ nil are excluded from the clock summation." (org-clock-sum tstart) org-clock-file-total-minutes))) +;;;###autoload (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) @@ -1548,8 +1811,8 @@ will be easy to remove." (org-move-to-column c) (unless (eolp) (skip-chars-backward "^ \t")) (skip-chars-backward " \t") - (setq ov (make-overlay (1- (point)) (point-at-eol)) - tx (concat (buffer-substring (1- (point)) (point)) + (setq ov (make-overlay (point-at-bol) (point-at-eol)) + tx (concat (buffer-substring (point-at-bol) (point)) (make-string (+ off (max 0 (- c (current-column)))) ?.) (org-add-props (if org-time-clocksum-use-fractional (format fmt @@ -1579,16 +1842,18 @@ from the `before-change-functions' in the current buffer." (remove-hook 'before-change-functions 'org-clock-remove-overlays 'local)))) -(defvar state) ;; dynamically scoped into this function +(defvar org-state) ;; dynamically scoped into this function (defun org-clock-out-if-current () "Clock out if the current entry contains the running clock. This is used to stop the clock after a TODO entry is marked DONE, and is only done if the variable `org-clock-out-when-done' is not nil." - (when (and org-clock-out-when-done + (when (and (org-clocking-p) + org-clock-out-when-done + (marker-buffer org-clock-marker) (or (and (eq t org-clock-out-when-done) - (member state org-done-keywords)) + (member org-state org-done-keywords)) (and (listp org-clock-out-when-done) - (member state org-clock-out-when-done))) + (member org-state org-clock-out-when-done))) (equal (or (buffer-base-buffer (org-clocking-buffer)) (org-clocking-buffer)) (or (buffer-base-buffer (current-buffer)) @@ -1605,7 +1870,7 @@ and is only done if the variable `org-clock-out-when-done' is not nil." 'org-clock-out-if-current) ;;;###autoload -(defun org-get-clocktable (&rest props) +(defun org-clock-get-clocktable (&rest props) "Get a formatted clocktable with parameters according to PROPS. The table is created in a temporary buffer, fully formatted and fontified, and then returned." @@ -1625,10 +1890,14 @@ fontified, and then returned." (re-search-forward "^[ \t]*#\\+END" nil t) (point-at-bol))))) +;;;###autoload (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") @@ -1638,21 +1907,14 @@ buffer and update it." (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 () - "Check if the cursor is in a clocktable." - (let ((pos (point)) start) - (save-excursion - (end-of-line 1) - (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t) - (setq start (match-beginning 0)) - (re-search-forward "^[ \t]*#\\+END:.*" nil t) - (>= (match-end 0) pos) - start)))) - (defun org-day-of-week (day month year) "Returns the day of the week as an integer." (nth 6 @@ -1747,13 +2009,13 @@ the returned times will be formatted strings." (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) + ((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) @@ -1764,12 +2026,11 @@ the returned times will be formatted strings." ((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.") - ()))) + (if (and (memq key '(quarter thisq)) (> shift 0)) + (error "Looking forward with quarters isn't implemented")))) (when (= shift 0) - (cond ((eq key 'yesterday) (setq key 'today shift -1)) + (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)) @@ -1783,27 +2044,27 @@ the returned times will be formatted strings." ((memq key '(month thismonth)) (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0)) ((memq key '(quarter thisq)) - ; compute if this shift remains in this year - ; if not, compute how many years and quarters we have to shift (via floor*) - ; and compute the shifted years, months and quarters + ; compute if this shift remains in this year + ; if not, compute how many years and quarters we have to shift (via floor*) + ; and compute the shifted years, months and quarters (cond ((< (+ (- q 1) shift) 0) ; shift not in this year - (setq interval (* -1 (+ (- q 1) shift))) - ; set tmp to ((years to shift) (quarters to shift)) - (setq tmp (org-floor* interval 4)) - ; due to the use of floor, 0 quarters actually means 4 - (if (= 0 (nth 1 tmp)) - (setq shiftedy (- y (nth 0 tmp)) - shiftedm 1 - shiftedq 1) - (setq shiftedy (- y (+ 1 (nth 0 tmp))) - shiftedm (- 13 (* 3 (nth 1 tmp))) - shiftedq (- 5 (nth 1 tmp)))) - (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy)) - ((> (+ q shift) 0) ; shift is whitin this year - (setq shiftedq (+ q shift)) - (setq shiftedy y) - (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0)))) + (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))) @@ -1821,7 +2082,7 @@ the returned times will be formatted strings." ((memq key '(year thisyear)) (setq txt (format-time-string "the year %Y" ts))) ((memq key '(quarter thisq)) - (setq txt (concatenate 'string (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))) + (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))) ) (if as-strings (list (format-time-string fm ts) (format-time-string fm te) txt) @@ -1859,61 +2120,64 @@ the currently selected interval size." ((equal s "lastyear") (setq s "thisyear-1")) ((equal s "lastq") (setq s "thisq-1"))) - (cond - ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s) - (setq block (match-string 1 s) - shift (if (match-end 2) - (string-to-number (match-string 2 s)) - 0)) - (setq shift (+ shift n)) - (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) - ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) - ;; 1 1 2 3 3 4 4 5 6 6 5 2 - (setq y (string-to-number (match-string 1 s)) - wp (and (match-end 3) (match-string 3 s)) - mw (and (match-end 4) (string-to-number (match-string 4 s))) - d (and (match-end 6) (string-to-number (match-string 6 s)))) - (cond - (d (setq ins (format-time-string - "%Y-%m-%d" - (encode-time 0 0 0 (+ d n) m y)))) - ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) - (require 'cal-iso) - (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y)))) - (setq ins (format-time-string - "%G-W%V" - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) - ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0)) - (require 'cal-iso) - ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year - (if (> (+ mw n) 4) - (setq mw 0 - y (+ 1 y)) - ()) - ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year - (if (= (+ mw n) 0) - (setq mw 5 - y (- y 1)) - ()) - (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y)))) - (setq ins (format-time-string - (concatenate 'string (number-to-string y) "-Q" (number-to-string (+ mw n))) - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) - (mw - (setq ins (format-time-string - "%Y-%m" - (encode-time 0 0 0 1 (+ mw n) y)))) - (y - (setq ins (number-to-string (+ y n)))))) - (t (error "Cannot shift clocktable block"))) - (when ins - (goto-char b) - (insert ins) - (delete-region (point) (+ (point) (- e b))) - (beginning-of-line 1) - (org-update-dblock) - t))))) + (cond + ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s) + (setq block (match-string 1 s) + shift (if (match-end 2) + (string-to-number (match-string 2 s)) + 0)) + (setq shift (+ shift n)) + (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) + ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) + ;; 1 1 2 3 3 4 4 5 6 6 5 2 + (setq y (string-to-number (match-string 1 s)) + wp (and (match-end 3) (match-string 3 s)) + mw (and (match-end 4) (string-to-number (match-string 4 s))) + d (and (match-end 6) (string-to-number (match-string 6 s)))) + (cond + (d (setq ins (format-time-string + "%Y-%m-%d" + (encode-time 0 0 0 (+ d n) m y)))) + ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) + (require 'cal-iso) + (setq date (calendar-gregorian-from-absolute + (calendar-absolute-from-iso (list (+ mw n) 1 y)))) + (setq ins (format-time-string + "%G-W%V" + (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) + ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0)) + (require 'cal-iso) + ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year + (if (> (+ mw n) 4) + (setq mw 0 + y (+ 1 y)) + ()) + ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year + (if (= (+ mw n) 0) + (setq mw 5 + y (- y 1)) + ()) + (setq date (calendar-gregorian-from-absolute + (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y)))) + (setq ins (format-time-string + (concat (number-to-string y) "-Q" (number-to-string (+ mw n))) + (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) + (mw + (setq ins (format-time-string + "%Y-%m" + (encode-time 0 0 0 1 (+ mw n) y)))) + (y + (setq ins (number-to-string (+ y n)))))) + (t (error "Cannot shift clocktable block"))) + (when ins + (goto-char b) + (insert ins) + (delete-region (point) (+ (point) (- e b))) + (beginning-of-line 1) + (org-update-dblock) + t))))) +;;;###autoload (defun org-dblock-write:clocktable (params) "Write the standard clocktable." (setq params (org-combine-plists org-clocktable-defaults params)) @@ -1931,7 +2195,6 @@ the currently selected interval size." 'org-clocktable-write-default)) cc range-text ipos pos one-file-with-archives scope-is-list tbls level) - ;; Check if we need to do steps (when block ;; Get the range text for the header @@ -1964,7 +2227,7 @@ the currently selected interval size." ;; we collect from several files (let* ((files scope) file) - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (while (setq file (pop files)) (with-current-buffer (find-buffer-visiting file) (save-excursion @@ -1973,7 +2236,7 @@ the currently selected interval size." ;; Just from the current file (save-restriction ;; get the right range into the restriction - (org-prepare-agenda-buffers (list (buffer-file-name))) + (org-agenda-prepare-buffers (list (buffer-file-name))) (cond ((not scope)) ; use the restriction as it is now ((eq scope 'file) (widen)) @@ -1986,7 +2249,7 @@ the currently selected interval size." (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))) @@ -2006,13 +2269,17 @@ the currently selected interval size." "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)) @@ -2024,9 +2291,11 @@ from the dynamic block defintion." (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)) + (case-fold-search t) range-text total-time tbl level hlc formula pcol file-time entries entry headline recalc content narrow-cut-p tcol) @@ -2036,181 +2305,196 @@ from the dynamic block defintion." (setq level nil indent t narrow (or narrow '40!) ntcol 1)) ;; Some consistency test for parameters - (unless (integerp ntcol) - (setq params (plist-put params :tcolumns (setq ntcol 100)))) - - (when (and narrow (integerp narrow) link) - ;; We cannot have both integer narrow and link - (message - "Using hard narrowing in clocktable to allow for links") - (setq narrow (intern (format "%d!" narrow)))) - - (when narrow - (cond - ((integerp narrow)) - ((and (symbolp narrow) - (string-match "\\`[0-9]+!\\'" (symbol-name narrow))) - (setq narrow-cut-p t - narrow (string-to-number (substring (symbol-name narrow) - 0 -1)))) - (t - (error "Invalid value %s of :narrow property in clock table" - narrow)))) - - (when block - ;; Get the range text for the header - (setq range-text (nth 2 (org-clock-special-range block nil t)))) + (unless (integerp ntcol) + (setq params (plist-put params :tcolumns (setq ntcol 100)))) - ;; Compute the total time - (setq total-time (apply '+ (mapcar 'cadr tables))) + (when (and narrow (integerp narrow) link) + ;; We cannot have both integer narrow and link + (message + "Using hard narrowing in clocktable to allow for links") + (setq narrow (intern (format "%d!" narrow)))) - ;; Now we need to output this tsuff - (goto-char ipos) - - ;; Insert the text *before* the actual table - (insert-before-markers - (or header - ;; Format the standard header - (concat - "Clock summary at [" - (substring - (format-time-string (cdr org-time-stamp-formats)) - 1 -1) - "]" - (if block (concat ", for " range-text ".") "") - "\n\n"))) - - ;; Insert the narrowing line - (when (and narrow (integerp narrow) (not narrow-cut-p)) - (insert-before-markers - "|" ; table line starter - (if multifile "|" "") ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe - (format "<%d>| |\n" narrow))) ; headline and time columns - - ;; Insert the table header line - (insert-before-markers - "|" ; table line starter - (if multifile "File|" "") ; file column, maybe - (if level-p "L|" "") ; level column, maybe - (if timestamp "Timestamp|" "") ; timestamp column, maybe - "Headline|Time|\n") ; headline and time columns + (when narrow + (cond + ((integerp narrow)) + ((and (symbolp narrow) + (string-match "\\`[0-9]+!\\'" (symbol-name narrow))) + (setq narrow-cut-p t + narrow (string-to-number (substring (symbol-name narrow) + 0 -1)))) + (t + (error "Invalid value %s of :narrow property in clock table" + narrow)))) - ;; Insert the total time in the table + (when block + ;; Get the range text for the header + (setq range-text (nth 2 (org-clock-special-range block nil t)))) + + ;; Compute the total time + (setq total-time (apply '+ (mapcar 'cadr tables))) + + ;; Now we need to output this tsuff + (goto-char ipos) + + ;; Insert the text *before* the actual table + (insert-before-markers + (or header + ;; Format the standard header + (concat + (nth 9 lwords) " [" + (substring + (format-time-string (cdr org-time-stamp-formats)) + 1 -1) + "]" + (if block (concat ", for " range-text ".") "") + "\n\n"))) + + ;; Insert the narrowing line + (when (and narrow (integerp narrow) (not narrow-cut-p)) (insert-before-markers - "|-\n" ; a hline - "|" ; table line starter - (if multifile "| ALL " "") ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe - "*Total time*| " ; instead of a headline - "*" - (org-minutes-to-hh:mm-string (or total-time 0)) ; the time - "*|\n") ; close line - - ;; Now iterate over the tables and insert the data - ;; but only if any time has been collected - (when (and total-time (> total-time 0)) - - (while (setq tbl (pop tables)) - ;; now tbl is the table resulting from one file. - (setq file-time (nth 1 tbl)) - (when (or (and file-time (> file-time 0)) - (not (plist-get params :fileskip0))) - (insert-before-markers "|-\n") ; a hline because a new file starts - ;; First the file time, if we have multiple files - (when multifile - ;; Summarize the time colleted from this file - (insert-before-markers - (format "| %s %s | %s*File time* | *%s*|\n" - (file-name-nondirectory (car tbl)) - (if level-p "| " "") ; level column, maybe - (if timestamp "| " "") ; timestamp column, maybe - (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time - - ;; Get the list of node entries and iterate over it - (setq entries (nth 2 tbl)) - (while (setq entry (pop entries)) - (setq level (car entry) - headline (nth 1 entry) - hlc (if emph (or (cdr (assoc level hlchars)) "") "")) - (when narrow-cut-p - (if (and (string-match (concat "\\`" org-bracket-link-regexp - "\\'") - headline) - (match-end 3)) - (setq headline - (format "[[%s][%s]]" - (match-string 1 headline) - (org-shorten-string (match-string 3 headline) - narrow))) - (setq headline (org-shorten-string headline narrow)))) - (insert-before-markers - "|" ; start the table line - (if multifile "|" "") ; free space for file name column? - (if level-p (format "%d|" (car entry)) "") ; level, maybe - (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe - (if indent (org-clocktable-indent-string level) "") ; indentation - hlc headline hlc "|" ; headline - (make-string (min (1- ntcol) (or (- level 1))) ?|) + "|" ; table line starter + (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 (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 (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 (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline + (format org-clock-total-time-cell-format + (org-minutes-to-hh:mm-string (or total-time 0))) ; the time + "|\n") ; close line + + ;; Now iterate over the tables and insert the data + ;; but only if any time has been collected + (when (and total-time (> total-time 0)) + + (while (setq tbl (pop tables)) + ;; now tbl is the table resulting from one file. + (setq file-time (nth 1 tbl)) + (when (or (and file-time (> file-time 0)) + (not (plist-get params :fileskip0))) + (insert-before-markers "|-\n") ; a hline because a new file starts + ;; First the file time, if we have multiple files + (when multifile + ;; Summarize the time collected from this file + (insert-before-markers + (format (concat "| %s %s | %s%s" + (format org-clock-file-time-cell-format (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 + (setq entries (nth 2 tbl)) + (while (setq entry (pop entries)) + (setq level (car entry) + headline (nth 1 entry) + hlc (if emph (or (cdr (assoc level hlchars)) "") "")) + (when narrow-cut-p + (if (and (string-match (concat "\\`" org-bracket-link-regexp + "\\'") + headline) + (match-end 3)) + (setq headline + (format "[[%s][%s]]" + (match-string 1 headline) + (org-shorten-string (match-string 3 headline) + narrow))) + (setq headline (org-shorten-string headline narrow)))) + (insert-before-markers + "|" ; start the table line + (if multifile "|" "") ; free space for file name column? + (if level-p (format "%d|" (car entry)) "") ; level, maybe + (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe + (if 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))) ?|) ; empty fields for higher levels - hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time - "|\n" ; close line - ))))) - (backward-delete-char 1) - (if (setq formula (plist-get params :formula)) - (cond - ((eq formula '%) - ;; compute the column where the % numbers need to go - (setq pcol (+ 2 - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0) - (min maxlevel (or ntcol 100)))) - ;; compute the column where the total time is - (setq tcol (+ 2 - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0))) - (insert - (format - "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" - pcol ; the column where the % numbers should go - (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time - tcol ; column of the total time - tcol (1- pcol) ; range of columns where times can be found - )) - (setq recalc t)) - ((stringp formula) - (insert "\n#+TBLFM: " formula) - (setq recalc t)) - (t (error "invalid formula in clocktable"))) - ;; Should we rescue an old formula? - (when (stringp (setq content (plist-get params :content))) - (when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content) - (setq recalc t) - (insert "\n" (match-string 1 (plist-get params :content))) - (beginning-of-line 0)))) - ;; Back to beginning, align the table, recalculate if necessary - (goto-char ipos) - (skip-chars-forward "^|") - (org-table-align) - (when org-hide-emphasis-markers - ;; we need to align a second time - (org-table-align)) - (when recalc - (if (eq formula '%) - (save-excursion - (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) - (org-table-goto-column pcol nil 'force) - (insert "%"))) - (org-table-recalculate 'all)) - (when rm-file-column - ;; The file column is actually not wanted - (forward-char 1) - (org-table-delete-column)) - total-time)) + hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time + "|\n" ; close line + ))))) + ;; When exporting subtrees or regions the region might be + ;; activated, so let's disable ̀delete-active-region' + (let ((delete-active-region nil)) (backward-delete-char 1)) + (if (setq formula (plist-get params :formula)) + (cond + ((eq formula '%) + ;; compute the column where the % numbers need to go + (setq pcol (+ 2 + (if multifile 1 0) + (if level-p 1 0) + (if timestamp 1 0) + (min maxlevel (or ntcol 100)))) + ;; compute the column where the total time is + (setq tcol (+ 2 + (if multifile 1 0) + (if level-p 1 0) + (if timestamp 1 0))) + (insert + (format + "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" + pcol ; the column where the % numbers should go + (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time + tcol ; column of the total time + tcol (1- pcol) ; range of columns where times can be found + )) + (setq recalc t)) + ((stringp formula) + (insert "\n#+TBLFM: " formula) + (setq recalc t)) + (t (error "Invalid formula in clocktable"))) + ;; Should we rescue an old formula? + (when (stringp (setq content (plist-get params :content))) + (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content) + (setq recalc t) + (insert "\n" (match-string 1 (plist-get params :content))) + (beginning-of-line 0)))) + ;; Back to beginning, align the table, recalculate if necessary + (goto-char ipos) + (skip-chars-forward "^|") + (org-table-align) + (when org-hide-emphasis-markers + ;; we need to align a second time + (org-table-align)) + (when recalc + (if (eq formula '%) + (save-excursion + (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) + (org-table-goto-column pcol nil 'force) + (insert "%"))) + (org-table-recalculate 'all)) + (when rm-file-column + ;; The file column is actually not wanted + (forward-char 1) + (org-table-delete-column)) + total-time)) (defun org-clocktable-indent-string (level) (if (= level 1) @@ -2305,6 +2589,9 @@ TIME: The sum of all time spend in this tree, in minutes. This time (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)) + todo-only (matcher (if tags (cdr (org-make-tags-matcher tags)))) cc range-text st p time level hdl props tsp tbl) @@ -2327,7 +2614,9 @@ TIME: The sum of all time spend in this tree, in minutes. This time (org-clock-sum ts te (unless (null matcher) (lambda () - (let ((tags-list (org-get-tags-at))) + (let* ((tags-list (org-get-tags-at)) + (org-scanner-tags tags-list) + (org-trust-scanner-tags t)) (eval matcher))))) (goto-char (point-min)) (setq st t) @@ -2358,8 +2647,15 @@ TIME: The sum of all time spend in this tree, in minutes. This time (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)))) @@ -2387,9 +2683,53 @@ This function is made for clock tables." tot)))) 0)))) +;; Saving and loading the clock + (defvar org-clock-loaded nil "Was the clock file loaded?") +(defun org-clock-update-time-maybe () + "If this is a CLOCK line, update it and return t. +Otherwise, return nil." + (interactive) + (save-excursion + (beginning-of-line 1) + (skip-chars-forward " \t") + (when (looking-at org-clock-string) + (let ((re (concat "[ \t]*" org-clock-string + " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]" + "\\([ \t]*=>.*\\)?\\)?")) + ts te h m s neg) + (cond + ((not (looking-at re)) + nil) + ((not (match-end 2)) + (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) + (> org-clock-marker (point)) + (<= org-clock-marker (point-at-eol))) + ;; The clock is running here + (setq org-clock-start-time + (apply 'encode-time + (org-parse-time-string (match-string 1)))) + (org-clock-update-mode-line))) + (t + (and (match-end 4) (delete-region (match-beginning 4) (match-end 4))) + (end-of-line 1) + (setq ts (match-string 1) + te (match-string 3)) + (setq s (- (org-float-time + (apply 'encode-time (org-parse-time-string te))) + (org-float-time + (apply 'encode-time (org-parse-time-string ts)))) + neg (< s 0) + s (abs s) + h (floor (/ s 3600)) + s (- s (* 3600 h)) + m (floor (/ s 60)) + s (- s (* 60 s))) + (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m)) + t)))))) + (defun org-clock-save () "Persist various clock-related data to disk. The details of what will be saved are regulated by the variable @@ -2420,7 +2760,7 @@ The details of what will be saved are regulated by the variable (buffer-file-name (org-clocking-buffer)) "\" . " (int-to-string (marker-position org-clock-marker)) "))\n")) - ;; Store clocked task history. Tasks are stored reversed to make + ;; Store clocked task history. Tasks are stored reversed to make ;; reading simpler (when (and (memq org-clock-persist '(t history)) org-clock-history) @@ -2478,20 +2818,16 @@ The details of what will be saved are regulated by the variable (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 -(defun org-clock-persistence-insinuate () - "Set up hooks for clock persistence." - (add-hook 'org-mode-hook 'org-clock-load) - (add-hook 'kill-emacs-hook 'org-clock-save)) - ;; Suggested bindings (org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate) (provide 'org-clock) +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: ;;; org-clock.el ends here -