diff options
Diffstat (limited to 'elpa/org-9.5.2/org-clock.el')
| -rw-r--r-- | elpa/org-9.5.2/org-clock.el | 3149 |
1 files changed, 3149 insertions, 0 deletions
diff --git a/elpa/org-9.5.2/org-clock.el b/elpa/org-9.5.2/org-clock.el new file mode 100644 index 0000000..143ed4f --- /dev/null +++ b/elpa/org-9.5.2/org-clock.el @@ -0,0 +1,3149 @@ +;;; org-clock.el --- The time clocking code for Org mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2004-2021 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten.dominik@gmail.com> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains the time clocking code for Org mode + +;;; Code: + +(require 'cl-lib) +(require 'org) + +(declare-function calendar-iso-to-absolute "cal-iso" (date)) +(declare-function notifications-notify "notifications" (&rest params)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-inlinetask-at-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-goto-end "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-link-display-format "ol" (s)) +(declare-function org-link-heading-search-string "ol" (&optional string)) +(declare-function org-link-make-string "ol" (link &optional description)) +(declare-function org-table-goto-line "org-table" (n)) +(declare-function org-dynamic-block-define "org" (type func)) +(declare-function w32-notification-notify "w32fns.c" (&rest params)) +(declare-function w32-notification-close "w32fns.c" (&rest params)) + +(defvar org-frame-title-format-backup nil) +(defvar org-state) +(defvar org-link-bracket-re) +(defvar org-time-stamp-formats) + +(defgroup org-clock nil + "Options concerning clocking working time in Org mode." + :tag "Org Clock" + :group 'org-progress) + +(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 "26.1" + :package-version '(Org . "8.3") + :type '(choice + (const :tag "Always" t) + (const :tag "Only when drawer exists" nil) + (integer :tag "When at least N clock entries") + (const :tag "Into LOGBOOK drawer" "LOGBOOK") + (string :tag "Into Drawer named..."))) + +(defun org-clock-into-drawer () + "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. + +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 (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. +\\<org-mode-map>\ +DONE here means any DONE-like state. +A nil value means clock will keep running until stopped explicitly with +`\\[org-clock-out]', or until the clock is started in a different item. +Instead of t, this can also be a list of TODO states that should trigger +clocking out." + :group 'org-clock + :type '(choice + (const :tag "No" nil) + (const :tag "Yes, when done" t) + (repeat :tag "State list" + (string :tag "TODO keyword")))) + +(defcustom org-clock-rounding-minutes 0 + "Rounding minutes when clocking in or out. +The default value is 0 so that no rounding is done. +When set to a non-integer value, use the car of +`org-time-stamp-rounding-minutes', like for setting a time-stamp. + +E.g. if `org-clock-rounding-minutes' is set to 5, time is 14:47 +and you clock in: then the clock starts at 14:45. If you clock +out within the next 5 minutes, the clock line will be removed; +if you clock out 8 minutes after your clocked in, the clock +out time will be 14:50." + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (integer :tag "Minutes (0 for no rounding)") + (symbol :tag "Use `org-time-stamp-rounding-minutes'" 'same-as-time-stamp))) + +(defcustom org-clock-out-remove-zero-time-clocks nil + "Non-nil means remove the clock line when the resulting time is zero." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-in-switch-to-state nil + "Set task to a special todo state while clocking it. +The value should be the state to which the entry should be +switched. If the value is a function, it must take one +parameter (the current TODO state of the item) and return the +state to switch it to." + :group 'org-clock + :group 'org-todo + :type '(choice + (const :tag "Don't force a state" nil) + (string :tag "State") + (symbol :tag "Function"))) + +(defcustom org-clock-out-switch-to-state nil + "Set task to a special todo state after clocking out. +The value should be the state to which the entry should be +switched. If the value is a function, it must take one +parameter (the current TODO state of the item) and return the +state to switch it to." + :group 'org-clock + :group 'org-todo + :type '(choice + (const :tag "Don't force a state" nil) + (string :tag "State") + (symbol :tag "Function"))) + +(defcustom org-clock-history-length 5 + "Number of clock tasks to remember in history. +Clocking in using history works best if this is at most 35, in +which case all digits and capital letters are used up by the +*Clock Task Select* buffer." + :group 'org-clock + :type 'integer) + +(defcustom org-clock-goto-may-find-recent-task t + "Non-nil means `org-clock-goto' can go to recent task if no active clock." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-heading-function nil + "When non-nil, should be a function to create `org-clock-heading'. +This is the string shown in the mode line when a clock is running. +The function is called with point at the beginning of the headline." + :group 'org-clock + :type '(choice (const nil) (function))) + +(defcustom org-clock-string-limit 0 + "Maximum length of clock strings in the mode line. 0 means no limit." + :group 'org-clock + :type 'integer) + +(defcustom org-clock-in-resume nil + "If non-nil, resume clock when clocking into task with open clock. +When clocking into a task with a clock entry which has not been closed, +the clock can be resumed from that point." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-persist nil + "When non-nil, save the running clock when Emacs is closed. +The clock is resumed when Emacs restarts. +When this is t, both the running clock, and the entire clock +history are saved. When this is the symbol `clock', only the +running clock is saved. When this is the symbol `history', only +the clock history is saved. + +When Emacs restarts with saved clock information, the file containing +the running clock as well as all files mentioned in the clock history +will be visited. + +All this depends on running `org-clock-persistence-insinuate' in your +Emacs initialization file." + :group 'org-clock + :type '(choice + (const :tag "Just the running clock" clock) + (const :tag "Just the history" history) + (const :tag "Clock and history" t) + (const :tag "No persistence" nil))) + +(defcustom org-clock-persist-file (convert-standard-filename + (concat user-emacs-directory "org-clock-save.el")) + "File to save clock data to." + :group 'org-clock + :type 'string) + +(defcustom org-clock-persist-query-save nil + "When non-nil, ask before saving the current clock on exit." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-persist-query-resume t + "When non-nil, ask before resuming any stored clock during load." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-sound nil + "Sound to use for notifications. +Possible values are: + +nil No sound played +t Standard Emacs beep +file name Play this sound file, fall back to beep" + :group 'org-clock + :type '(choice + (const :tag "No sound" nil) + (const :tag "Standard beep" t) + (file :tag "Play sound file"))) + +(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: + +current Only the time in the current instance of the clock +today All time clocked into this task today +repeat All time clocked into this task since last repeat +all All time ever recorded for this task +auto Automatically, either `all', or `repeat' for repeating tasks" + :group 'org-clock + :type '(choice + (const :tag "Current clock" current) + (const :tag "Today's task time" today) + (const :tag "Since last repeat" repeat) + (const :tag "All task time" all) + (const :tag "Automatically, `all' or since `repeat'" auto))) + +(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"))) + +(defcustom org-show-notification-timeout 3 + "Number of seconds to wait before closing Org notifications. +This is applied to notifications sent with `notifications-notify' +and `w32-notification-notify' only, not other mechanisms possibly +set through `org-show-notification-handler'." + :group 'org-clock + :package-version '(Org . "9.4") + :type 'integer) + +(defcustom org-show-notification-handler nil + "Function or program to send notification with. +The function or program will be called with the notification +string as argument." + :group 'org-clock + :type '(choice + (const nil) + (string :tag "Program") + (function :tag "Function"))) + +(defgroup org-clocktable nil + "Options concerning the clock table in Org mode." + :tag "Org Clock Table" + :group 'org-clock) + +(defcustom org-clocktable-defaults + (list + :maxlevel 2 + :lang (or (bound-and-true-p org-export-default-language) "en") + :scope 'file + :block nil + :wstart 1 + :mstart 1 + :tstart nil + :tend nil + :step nil + :stepskip0 nil + :fileskip0 nil + :tags nil + :match nil + :emphasize nil + :link nil + :narrow '40! + :indent t + :hidefiles nil + :formula nil + :timestamp nil + :level nil + :tcolumns nil + :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") + ("de" "Datei" "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT" + "Gesamtdauer" "Dateizeit" "Erstellt am")) + "Terms used in clocktable, translated to different languages." + :group 'org-clocktable + :version "24.1" + :type 'alist) + +(defcustom org-clock-clocktable-default-properties '(:maxlevel 2) + "Default properties for new clocktables. +These will be inserted into the BEGIN line, to make it easy for users to +play with them." + :group 'org-clocktable + :package-version '(Org . "9.2") + :type 'plist) + +(defcustom org-clock-idle-time nil + "When non-nil, resolve open clocks if the user is idle more than X minutes." + :group 'org-clock + :type '(choice + (const :tag "Never" nil) + (integer :tag "After N minutes"))) + +(defcustom org-clock-auto-clock-resolution 'when-no-clock-is-running + "When to automatically resolve open clocks found in Org buffers." + :group 'org-clock + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "When no clock is running" when-no-clock-is-running))) + +(defcustom org-clock-report-include-clocking-task nil + "When non-nil, include the current clocking task time in clock reports." + :group 'org-clock + :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 'string) + +(defcustom org-clock-file-time-cell-format "*%s*" + "Format string for the file time cells." + :group 'org-clock + :version "24.1" + :type 'string) + +(defcustom org-clock-clocked-in-display 'mode-line + "When clocked in for a task, Org 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) + +(defcustom org-clock-x11idle-program-name "x11idle" + "Name of the program which prints X11 idle time in milliseconds. + +you can do \"~$ sudo apt-get install xprintidle\" if you are using +a Debian-based distribution. + +Alternatively, can find x11idle.c in the org-contrib repository at +https://git.sr.ht/~bzg/org-contrib" + :group 'org-clock + :version "24.4" + :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'. +Valid values are: `today', `yesterday', `thisweek', `lastweek', +`thismonth', `lastmonth', `thisyear', `lastyear' and `untilnow'." + :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)) + :safe #'symbolp) + +(defcustom org-clock-auto-clockout-timer nil + "Timer for auto clocking out when Emacs is idle. +When set to a number, auto clock out the currently clocked in +task after this number of seconds of idle time. + +This is only effective when `org-clock-auto-clockout-insinuate' +is added to the user configuration." + :group 'org-clock + :package-version '(Org . "9.4") + :type '(choice + (integer :tag "Clock out after Emacs is idle for X seconds") + (const :tag "Never auto clock out" nil))) + +(defcustom org-clock-ask-before-exiting t + "If non-nil, ask if the user wants to clock out before exiting Emacs. +This variable only has effect if set with \\[customize]." + :set (lambda (symbol value) + (if value + (add-hook 'kill-emacs-query-functions #'org-clock-kill-emacs-query) + (remove-hook 'kill-emacs-query-functions #'org-clock-kill-emacs-query)) + (set symbol value)) + :type 'boolean + :package-version '(Org . "9.5")) + +(defvar org-clock-in-prepare-hook nil + "Hook run when preparing the clock. +This hook is run before anything happens to the task that +you want to clock in. For example, you can use this hook +to add an effort property.") +(defvar org-clock-in-hook nil + "Hook run when starting the clock.") +(defvar org-clock-out-hook nil + "Hook run when stopping the current clock.") + +(defvar org-clock-cancel-hook nil + "Hook run when canceling the current clock.") +(defvar org-clock-goto-hook nil + "Hook run when selecting the currently clocked-in entry.") +(defvar org-clock-has-been-used nil + "Has the clock been used during the current Emacs session?") + +(defvar org-clock-stored-history nil + "Clock history, populated by `org-clock-load'.") +(defvar org-clock-stored-resume-clock nil + "Clock to resume, saved by `org-clock-load'.") + +;;; The clock for measuring work time. + +(defvar org-mode-line-string "") +(put 'org-mode-line-string 'risky-local-variable t) + +(defvar org-clock-mode-line-timer nil) +(defvar org-clock-idle-timer nil) +(defvar org-clock-heading) ; defined in org.el +(defvar org-clock-start-time "") + +(defvar org-clock-leftover-time nil + "If non-nil, user canceled a clock; this is when leftover time started.") + +(defvar org-clock-effort "" + "Effort estimate of the currently clocking task.") + +(defvar org-clock-total-time nil + "Holds total time, spent previously on currently clocked item. +This does not include the time in the currently running clock.") + +(defvar org-clock-history nil + "List of marker pointing to recent clocked tasks.") + +(defvar org-clock-default-task (make-marker) + "Marker pointing to the default task that should clock time. +The clock can be made to switch to this task after clocking out +of a different task.") + +(defvar org-clock-interrupted-task (make-marker) + "Marker pointing to the task that has been interrupted by the current clock.") + +(defvar org-clock-mode-line-map (make-sparse-keymap)) +(define-key org-clock-mode-line-map [mode-line mouse-2] #'org-clock-goto) +(define-key org-clock-mode-line-map [mode-line mouse-1] #'org-clock-menu) + +(defun org-clock--translate (s language) + "Translate string S into using string LANGUAGE. +Assume S in the English term to translate. Return S as-is if it +cannot be translated." + (or (nth (pcase s + ("File" 1) ("L" 2) ("Timestamp" 3) ("Headline" 4) ("Time" 5) + ("ALL" 6) ("Total time" 7) ("File time" 8) ("Clock summary at" 9)) + (assoc-string language org-clock-clocktable-language-setup t)) + s)) + +(defun org-clock--mode-line-heading () + "Return currently clocked heading, formatted for mode line." + (cond ((functionp org-clock-heading-function) + (funcall org-clock-heading-function)) + ((org-before-first-heading-p) "???") + (t (org-link-display-format + (org-no-properties (org-get-heading t t t t)))))) + +(defun org-clock-menu () + (interactive) + (popup-menu + '("Clock" + ["Clock out" org-clock-out t] + ["Change effort estimate" org-clock-modify-effort-estimate t] + ["Go to clock entry" org-clock-goto t] + ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]))) + +(defun org-clock-history-push (&optional pos buffer) + "Push a marker to the clock history." + (setq org-clock-history-length (max 1 org-clock-history-length)) + (let ((m (move-marker (make-marker) + (or pos (point)) (org-base-buffer + (or buffer (current-buffer))))) + n l) + (while (setq n (member m org-clock-history)) + (move-marker (car n) nil)) + (setq org-clock-history + (delq nil + (mapcar (lambda (x) (if (marker-buffer x) x nil)) + org-clock-history))) + (when (>= (setq l (length org-clock-history)) org-clock-history-length) + (setq org-clock-history + (nreverse + (nthcdr (- l org-clock-history-length -1) + (nreverse org-clock-history))))) + (push m org-clock-history))) + +(defun org-clock-save-markers-for-cut-and-paste (beg end) + "Save relative positions of markers in region." + (org-check-and-save-marker org-clock-marker beg end) + (org-check-and-save-marker org-clock-hd-marker beg end) + (org-check-and-save-marker org-clock-default-task beg end) + (org-check-and-save-marker org-clock-interrupted-task beg end) + (dolist (m org-clock-history) + (org-check-and-save-marker m beg end))) + +(defun org-clock-drawer-name () + "Return clock drawer's name for current entry, or nil." + (let ((drawer (org-clock-into-drawer))) + (cond ((integerp drawer) + (let ((log-drawer (org-log-into-drawer))) + (if (stringp log-drawer) log-drawer "LOGBOOK"))) + ((stringp drawer) drawer) + (t nil)))) + +(defun org-clocking-p () + "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 was recently associated with clocking. +Return marker position of the selected task. Raise an error if +there is no recent clock to choose from." + (let (och chl sel-list rpl (i 0) s) + ;; Remove successive dups from the clock history to consider + (dolist (c org-clock-history) + (unless (equal c (car och)) (push c och))) + (setq och (reverse och) chl (length och)) + (if (zerop chl) + (user-error "No recent clock") + (save-window-excursion + (org-switch-to-buffer-other-window + (get-buffer-create "*Clock Task Select*")) + (erase-buffer) + (when (marker-buffer org-clock-default-task) + (insert (org-add-props "Default Task\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?d org-clock-default-task)) + (push s sel-list)) + (when (marker-buffer org-clock-interrupted-task) + (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task)) + (push s sel-list)) + (when (org-clocking-p) + (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?c org-clock-marker)) + (push s sel-list)) + (insert (org-add-props "Recent Tasks\n" nil 'face 'bold)) + (dolist (m och) + (when (marker-buffer m) + (setq i (1+ i) + s (org-clock-insert-selection-line + (if (< i 10) + (+ i ?0) + (+ i (- ?A 10))) m)) + (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) + (push s sel-list))) + (run-hooks 'org-clock-before-select-task-hook) + (goto-char (point-min)) + ;; Set min-height relatively to circumvent a possible but in + ;; `fit-window-to-buffer' + (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) + ((assoc rpl sel-list) (cdr (assoc rpl sel-list))) + (t (user-error "Invalid task choice %c" rpl))))))) + +(defun org-clock-insert-selection-line (i marker) + "Insert a line for the clock selection menu. +And return a cons cell with the selection character integer and the marker +pointing to it." + (when (marker-buffer marker) + (let (cat task heading prefix) + (with-current-buffer (org-base-buffer (marker-buffer marker)) + (org-with-wide-buffer + (ignore-errors + (goto-char marker) + (setq cat (org-get-category) + heading (org-get-heading 'notags) + prefix (save-excursion + (org-back-to-heading t) + (looking-at org-outline-regexp) + (match-string 0)) + task (substring + (org-fontify-like-in-org-mode + (concat prefix heading) + org-odd-levels-only) + (length prefix)))))) + (when (and cat task) + (insert (format "[%c] %-12s %s\n" i cat task)) + (cons i marker))))) + +(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.") + +(defun org-clock-get-clock-string () + "Form a clock-string, that will be shown in the mode line. +If an effort estimate was defined for the current item, use +01:30/01:50 format (clocked/estimated). +If not, show simply the clocked time like 01:50." + (let ((clocked-time (org-clock-get-clocked-time))) + (if org-clock-effort + (let* ((effort-in-minutes (org-duration-to-minutes org-clock-effort)) + (work-done-str + (propertize (org-duration-from-minutes clocked-time) + 'face + (if (and org-clock-task-overrun + (not org-clock-task-overrun-text)) + 'org-mode-line-clock-overrun + 'org-mode-line-clock))) + (effort-str (org-duration-from-minutes effort-in-minutes))) + (format (propertize " [%s/%s] (%s)" 'face 'org-mode-line-clock) + work-done-str effort-str org-clock-heading)) + (format (propertize " [%s] (%s)" 'face 'org-mode-line-clock) + (org-duration-from-minutes clocked-time) + org-clock-heading)))) + +(defun org-clock-get-last-clock-out-time () + "Get the last clock-out time for the current subtree." + (save-excursion + (let ((end (save-excursion (org-end-of-subtree)))) + (when (re-search-forward (concat org-clock-string + ".*\\]--\\(\\[[^]]+\\]\\)") + end t) + (org-time-string-to-time (match-string 1)))))) + +(defun org-clock-update-mode-line (&optional refresh) + "Update mode line with clock information. +When optional argument is non-nil, refresh cached heading." + (if org-clock-effort + (org-clock-notify-once-if-expired) + (setq org-clock-task-overrun nil)) + (when refresh (setq org-clock-heading (org-clock--mode-line-heading))) + (setq org-mode-line-string + (propertize + (let ((clock-string (org-clock-get-clock-string)) + (help-text "Org mode clock is running.\nmouse-1 shows a \ +menu\nmouse-2 will jump to task")) + (if (and (> org-clock-string-limit 0) + (> (length clock-string) org-clock-string-limit)) + (propertize + (substring clock-string 0 org-clock-string-limit) + 'help-echo (concat help-text ": " org-clock-heading)) + (propertize clock-string 'help-echo help-text))) + 'local-map org-clock-mode-line-map + 'mouse-face 'mode-line-highlight)) + (if (and org-clock-task-overrun org-clock-task-overrun-text) + (setq org-mode-line-string + (concat (propertize + org-clock-task-overrun-text + 'face 'org-mode-line-clock-overrun) + org-mode-line-string))) + (force-mode-line-update)) + +(defun org-clock-get-clocked-time () + "Get the clocked time for the current item in minutes. +The time returned includes the time spent on this task in +previous clocking intervals." + (let ((currently-clocked-time + (floor (org-time-convert-to-integer + (org-time-since org-clock-start-time)) + 60))) + (+ 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. +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. If the effort value is expressed +as an unit defined in `org-duration-units' (e.g. \"3h\"), the modified +value will be converted to a hh:mm duration. + +This command will update the \"Effort\" property of the currently +clocked item, and the value displayed in the mode line." + (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-to-minutes current) + value (substring value 1)) + (setq current 0)) + (setq value (org-duration-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-duration-from-minutes 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.") + +(defun org-clock-notify-once-if-expired () + "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-duration-to-minutes org-clock-effort)) + (clocked-time (org-clock-get-clocked-time))) + (if (setq org-clock-task-overrun + (if (or (null effort-in-minutes) (zerop effort-in-minutes)) + nil + (>= clocked-time effort-in-minutes))) + (unless org-clock-notification-was-shown + (setq org-clock-notification-was-shown t) + (org-notify + (format-message "Task `%s' should be finished by now. (%s)" + org-clock-heading org-clock-effort) + org-clock-sound)) + (setq org-clock-notification-was-shown nil))))) + +(defun org-notify (notification &optional play-sound) + "Send a NOTIFICATION and maybe PLAY-SOUND. +If PLAY-SOUND is non-nil, it overrides `org-clock-sound'." + (org-show-notification notification) + (if play-sound (org-clock-play-sound play-sound))) + +(defun org-show-notification (notification) + "Show notification. +Use `org-show-notification-handler' if defined, +use libnotify if available, or fall back on a message." + (ignore-errors (require 'notifications)) + (cond ((functionp org-show-notification-handler) + (funcall org-show-notification-handler notification)) + ((stringp org-show-notification-handler) + (start-process "emacs-timer-notification" nil + org-show-notification-handler notification)) + ((fboundp 'w32-notification-notify) + (let ((id (w32-notification-notify + :title "Org mode message" + :body notification + :urgency 'low))) + (run-with-timer + org-show-notification-timeout + nil + (lambda () (w32-notification-close id))))) + ((fboundp 'ns-do-applescript) + (ns-do-applescript + (format "display notification \"%s\" with title \"Org mode notification\"" + (replace-regexp-in-string "\"" "#" notification)))) + ((fboundp 'notifications-notify) + (notifications-notify + :title "Org mode message" + :body notification + :timeout (* org-show-notification-timeout 1000) + ;; FIXME how to link to the Org icon? + ;; :app-icon "~/.emacs.d/icons/mail.png" + :urgency 'low)) + ((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 + ;; a fall back option + (t (message "%s" notification)))) + +(defun org-clock-play-sound (&optional clock-sound) + "Play sound as configured by `org-clock-sound'. +Use alsa's aplay tool if available. +If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." + (let ((org-clock-sound (or clock-sound org-clock-sound))) + (cond + ((not org-clock-sound)) + ((eq org-clock-sound t) (beep t) (beep t)) + ((stringp org-clock-sound) + (let ((file (expand-file-name org-clock-sound))) + (if (file-exists-p file) + (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)))))))))) + +(defvar org-clock-mode-line-entry nil + "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." + (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 org-clock-re nil t) + (push (cons (copy-marker (match-end 1) t) + (org-time-string-to-time (match-string 1))) + clocks)))) + clocks)) + +(defsubst org-is-active-clock (clock) + "Return t if CLOCK is the currently active clock." + (and (org-clock-is-active) + (= org-clock-marker (car clock)))) + +(defmacro org-with-clock-position (clock &rest forms) + "Evaluate FORMS with CLOCK as the current active clock." + (declare (indent 1) (debug t)) + `(with-current-buffer (marker-buffer (car ,clock)) + (org-with-wide-buffer + (goto-char (car ,clock)) + (beginning-of-line) + ,@forms))) + +(defmacro org-with-clock (clock &rest forms) + "Evaluate FORMS with CLOCK as the current active clock. +This macro also protects the current active clock from being altered." + (declare (indent 1) (debug t)) + `(org-with-clock-position ,clock + (let ((org-clock-start-time (cdr ,clock)) + (org-clock-total-time) + (org-clock-history) + (org-clock-effort) + (org-clock-marker (car ,clock)) + (org-clock-hd-marker (save-excursion + (org-back-to-heading t) + (point-marker)))) + ,@forms))) + +(defsubst org-clock-clock-in (clock &optional resume start-time) + "Clock in to the clock located by CLOCK. +If necessary, clock-out of the currently active clock." + (org-with-clock-position clock + (let ((org-clock-in-resume (or resume org-clock-in-resume))) + (org-clock-in nil start-time)))) + +(defsubst org-clock-clock-out (clock &optional fail-quietly at-time) + "Clock out of the clock located by CLOCK." + (let ((temp (copy-marker (car clock) + (marker-insertion-type (car clock))))) + (if (org-is-active-clock clock) + (org-clock-out nil fail-quietly at-time) + (org-with-clock clock + (org-clock-out nil fail-quietly at-time))) + (setcar clock temp))) + +(defsubst org-clock-clock-cancel (clock) + "Cancel the clock located by CLOCK." + (let ((temp (copy-marker (car clock) + (marker-insertion-type (car clock))))) + (if (org-is-active-clock clock) + (org-clock-cancel) + (org-with-clock clock + (org-clock-cancel))) + (setcar clock temp))) + +(defvar org-clock-clocking-in nil) +(defvar org-clock-resolving-clocks nil) +(defvar org-clock-resolving-clocks-due-to-idleness nil) + +(defun org-clock-resolve-clock + (clock resolve-to clock-out-time close restart fail-quietly) + "Resolve CLOCK given the time RESOLVE-TO, and the present. +CLOCK is a cons cell of the form (MARKER START-TIME)." + (let ((org-clock-resolving-clocks t) + ;; If the clocked entry contained only a clock and possibly + ;; the associated drawer, and we either cancel it or clock it + ;; out, `org-clock-out-remove-zero-time-clocks' may clear all + ;; contents, and leave point on the /next/ headline. We store + ;; the current entry location to be able to get back here when + ;; we need to clock in again the previously clocked task. + (heading (org-with-point-at (car clock) + (org-back-to-heading t) + (point-marker)))) + (pcase resolve-to + (`nil + (org-clock-clock-cancel clock) + (when (and restart (not org-clock-clocking-in)) + (org-with-point-at heading (org-clock-in)))) + (`now + (cond + (restart (error "RESTART is not valid here")) + ((or close org-clock-clocking-in) + (org-clock-clock-out clock fail-quietly)) + ((org-is-active-clock clock) nil) + (t (org-clock-clock-in clock t)))) + ((pred (org-time-less-p nil)) + (error "RESOLVE-TO must refer to a time in the past")) + (_ + (when restart (error "RESTART is not valid here")) + (org-clock-clock-out clock fail-quietly (or clock-out-time resolve-to)) + (cond + (org-clock-clocking-in nil) + (close + (setq org-clock-leftover-time (and (null clock-out-time) resolve-to))) + (t + (org-with-point-at heading + (org-clock-in nil (and clock-out-time resolve-to))))))))) + +(defun org-clock-jump-to-current-clock (&optional effective-clock) + "When an Org clock is running, jump to it." + (let ((drawer (org-clock-into-drawer)) + (clock (or effective-clock (cons org-clock-marker + org-clock-start-time)))) + (unless (marker-buffer (car clock)) + (user-error "No Org clock is currently running")) + (org-with-clock clock (org-clock-goto)) + (with-current-buffer (marker-buffer (car clock)) + (goto-char (car clock)) + (when drawer + (org-with-wide-buffer + (let ((drawer-re (format "^[ \t]*:%s:[ \t]*$" + (regexp-quote (if (stringp drawer) drawer "LOGBOOK")))) + (beg (save-excursion (org-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-hide-drawer-toggle 'off nil element)) + (throw 'exit nil))))))))))) + +(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) + "Resolve an open Org clock. +An open clock was found, with `dangling' possibly being non-nil. +If this function was invoked with a prefix argument, non-dangling +open clocks are ignored. The given clock requires some sort of +user intervention to resolve it, either because a clock was left +dangling or due to an idle timeout. The clock resolution can +either be: + + (a) deleted, the user doesn't care about the clock + (b) restarted from the current time (if no other clock is open) + (c) closed, giving the clock X minutes + (d) closed and then restarted + (e) resumed, as if the user had never left + +The format of clock is (CONS MARKER START-TIME), where MARKER +identifies the buffer and position the clock is open at (and +thus, the heading it's under), and START-TIME is when the clock +was started." + (cl-assert clock) + (let* ((ch + (save-window-excursion + (save-excursion + (unless org-clock-resolving-clocks-due-to-idleness + (org-clock-jump-to-current-clock clock)) + (unless org-clock-resolve-expert + (with-output-to-temp-buffer "*Org Clock*" + (princ (format-message "Select a Clock Resolution Command: + +i/q Ignore this question; the same as keeping all the idle time. + +k/K Keep X minutes of the idle time (default is all). If this + amount is less than the default, you will be clocked out + that many minutes after the time that idling began, and then + clocked back in at the present time. + +t/T Like `k', but will ask you to specify a time (when you got + distracted away), instead of a number of minutes. + +g/G Indicate that you \"got back\" X minutes ago. This is quite + different from `k': it clocks you out from the beginning of + the idle period and clock you back in X minutes ago. + +s/S Subtract the idle time from the current clock. This is the + same as keeping 0 minutes. + +C Cancel the open timer altogether. It will be as though you + never clocked in. + +j/J Jump to the current clock, to make manual adjustments. + +For all these options, using uppercase makes your final state +to be CLOCKED OUT.")))) + (org-fit-window-to-buffer (get-buffer-window "*Org Clock*")) + (let (char-pressed) + (while (or (null char-pressed) + (and (not (memq char-pressed + '(?k ?K ?g ?G ?s ?S ?C + ?j ?J ?i ?q ?t ?T))) + (or (ding) t))) + (setq char-pressed + (read-char (concat (funcall prompt-fn clock) + " [jkKtTgGSscCiq]? ") + nil 45))) + (and (not (memq char-pressed '(?i ?q))) char-pressed))))) + (default + (floor (org-time-convert-to-integer (org-time-since last-valid)) + 60)) + (keep + (or (and (memq ch '(?k ?K)) + (read-number "Keep how many minutes? " default)) + (and (memq ch '(?t ?T)) + (floor + (/ (float-time + (org-time-subtract (org-read-date t t) last-valid)) + 60))))) + (gotback + (and (memq ch '(?g ?G)) + (read-number "Got back how many minutes ago? " default))) + (subtractp (memq ch '(?s ?S))) + (barely-started-p (org-time-less-p + (org-time-subtract last-valid (cdr clock)) + 45)) + (start-over (and subtractp barely-started-p))) + (cond + ((memq ch '(?j ?J)) + (if (eq ch ?J) + (org-clock-resolve-clock clock 'now nil t nil fail-quietly)) + (org-clock-jump-to-current-clock clock)) + ((or (null ch) + (not (memq ch '(?k ?K ?g ?G ?s ?S ?C ?t ?T)))) + (message "")) + (t + (org-clock-resolve-clock + clock (cond + ((or (eq ch ?C) + ;; If the time on the clock was less than a minute before + ;; the user went away, and they've ask to subtract all the + ;; time... + start-over) + nil) + ((or subtractp + (and gotback (= gotback 0))) + last-valid) + ((or (and keep (= keep default)) + (and gotback (= gotback default))) + 'now) + (keep + (org-time-add last-valid (* 60 keep))) + (gotback + (org-time-since (* 60 gotback))) + (t + (error "Unexpected, please report this as a bug"))) + (and gotback last-valid) + (memq ch '(?K ?G ?S ?T)) + (and start-over + (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 clocks. +If `only-dangling-p' is non-nil, only ask to resolve dangling +\(i.e., not currently open and valid) clocks." + (interactive "P") + (unless org-clock-resolving-clocks + (let ((org-clock-resolving-clocks t)) + (dolist (file (org-files-list)) + (let ((clocks (org-find-open-clocks file))) + (dolist (clock clocks) + (let ((dangling (or (not (org-clock-is-active)) + (/= (car clock) org-clock-marker)))) + (if (or (not only-dangling-p) dangling) + (org-clock-resolve + clock + (or prompt-fn + (lambda (clock) + (format + "Dangling clock started %d mins ago" + (floor (org-time-convert-to-integer + (org-time-since (cdr clock))) + 60)))) + (or last-valid + (cdr clock))))))))))) + +(defun org-emacs-idle-seconds () + "Return the current Emacs idle time in seconds, or nil if not idle." + (let ((idle-time (current-idle-time))) + (if idle-time + (float-time idle-time) + 0))) + +(defun org-mac-idle-seconds () + "Return the current Mac idle time in seconds." + (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'"))) + +(defvar org-x11idle-exists-p + ;; Check that x11idle exists + (and (eq window-system 'x) + (eq 0 (call-process-shell-command + (format "command -v %s" org-clock-x11idle-program-name))) + ;; Check that x11idle can retrieve the idle time + ;; 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." + (/ (string-to-number (shell-command-to-string org-clock-x11idle-program-name)) 1000)) + +(defun org-user-idle-seconds () + "Return the number of seconds the user has been idle for. +This routine returns a floating point number." + (cond + ((eq system-type 'darwin) + (org-mac-idle-seconds)) + ((and (eq window-system 'x) org-x11idle-exists-p) + (org-x11-idle-seconds)) + (t + (org-emacs-idle-seconds)))) + +(defvar org-clock-user-idle-seconds) + +(defun org-resolve-clocks-if-idle () + "Resolve all currently open Org clocks. +This is performed after `org-clock-idle-time' minutes, to check +if the user really wants to stay clocked in after being idle for +so long." + (when (and org-clock-idle-time (not org-clock-resolving-clocks) + org-clock-marker (marker-buffer org-clock-marker)) + (let* ((org-clock-user-idle-seconds (org-user-idle-seconds)) + (org-clock-user-idle-start + (org-time-since org-clock-user-idle-seconds)) + (org-clock-resolving-clocks-due-to-idleness t)) + (if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time)) + (org-clock-resolve + (cons org-clock-marker + org-clock-start-time) + (lambda (_) + (format "Clocked in & idle for %.1f mins" + (/ (float-time + (time-since org-clock-user-idle-start)) + 60))) + org-clock-user-idle-start))))) + +(defvar org-clock-current-task nil "Task currently clocked in.") +(defvar org-clock-out-time nil) ; store the time of the last clock-out +(defvar org--msg-extra) + +;;;###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 `\\[universal-argument]' prefix argument SELECT, 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) + (org-refresh-effort-properties) + (catch 'abort + (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) + (org-clocking-p))) + ts selected-task target-pos (org--msg-extra "") + (leftover (and (not org-clock-resolving-clocks) + org-clock-leftover-time))) + + (when (and org-clock-auto-clock-resolution + (or (not interrupting) + (eq t org-clock-auto-clock-resolution)) + (not org-clock-clocking-in) + (not org-clock-resolving-clocks)) + (setq org-clock-leftover-time nil) + (let ((org-clock-clocking-in t)) + (org-resolve-clocks))) ; check if any clocks are dangling + + (when (equal select '(64)) + ;; Set start-time to `org-clock-out-time' + (let ((org-clock-continuously t)) + (org-clock-in nil org-clock-out-time) + (throw 'abort nil))) + + (when (equal select '(4)) + (pcase (org-clock-select-task "Clock-in on task: ") + (`nil (error "Abort")) + (task (setq selected-task (copy-marker task))))) + + (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. First check + ;; if we are trying to clock into the same task! + (when (or selected-task (derived-mode-p 'org-mode)) + (org-with-point-at selected-task + (unless selected-task (org-back-to-heading t)) + (when (and (eq (marker-buffer org-clock-hd-marker) + (org-base-buffer (current-buffer))) + (= (point) (marker-position org-clock-hd-marker)) + (equal org-clock-current-task (org-get-heading t t t t))) + (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 nil t))) + + ;; Clock in at which position? + (setq target-pos + (if (and (eobp) (not (org-at-heading-p))) + (point-at-bol 0) + (point))) + (save-excursion + (when (and selected-task (marker-buffer selected-task)) + ;; There is a selected task, move to the correct buffer + ;; and set the new target position. + (set-buffer (org-base-buffer (marker-buffer selected-task))) + (setq target-pos (marker-position selected-task)) + (move-marker selected-task nil)) + (org-with-wide-buffer + (goto-char target-pos) + (org-back-to-heading t) + (or interrupting (move-marker org-clock-interrupted-task nil)) + (run-hooks 'org-clock-in-prepare-hook) + (org-clock-history-push) + (setq org-clock-current-task (org-get-heading t t t t)) + (cond ((functionp org-clock-in-switch-to-state) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) + (let ((newstate (funcall org-clock-in-switch-to-state + (match-string 2)))) + (when newstate (org-todo newstate)))) + ((and org-clock-in-switch-to-state + (not (looking-at (concat org-outline-regexp "[ \t]*" + org-clock-in-switch-to-state + "\\>")))) + (org-todo org-clock-in-switch-to-state))) + (setq org-clock-heading (org-clock--mode-line-heading)) + (org-clock-find-position org-clock-in-resume) + (cond + ((and org-clock-in-resume + (looking-at + (concat "^[ \t]*" org-clock-string + " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" + " *\\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)) + (setq org-clock-start-time + (org-time-string-to-time (match-string 1))) + (setq org-clock-effort (org-entry-get (point) org-effort-property)) + (setq org-clock-total-time (org-clock-sum-current-item + (org-clock-get-sum-start)))) + ((eq org-clock-in-resume 'auto-restart) + ;; called from org-clock-load during startup, + ;; do not interrupt, but warn! + (message "Cannot restart clock because task does not contain unfinished clock") + (ding) + (sit-for 2) + (throw 'abort nil)) + (t + (insert-before-markers "\n") + (backward-char 1) + (when (and (save-excursion + (end-of-line 0) + (org-in-item-p))) + (beginning-of-line 1) + (indent-line-to (max 0 (- (current-indentation) 2)))) + (insert org-clock-string " ") + (setq org-clock-effort (org-entry-get (point) org-effort-property)) + (setq org-clock-total-time (org-clock-sum-current-item + (org-clock-get-sum-start))) + (setq org-clock-start-time + (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? " + (/ (org-time-convert-to-integer + (org-time-subtract + (org-current-time org-clock-rounding-minutes t) + leftover)) + 60))) + leftover) + start-time + (org-current-time org-clock-rounding-minutes t))) + (setq ts (org-insert-time-stamp org-clock-start-time + 'with-hm 'inactive)) + (org-indent-line))) + (move-marker org-clock-marker (point) (buffer-base-buffer)) + (move-marker org-clock-hd-marker + (save-excursion (org-back-to-heading t) (point)) + (buffer-base-buffer)) + (setq org-clock-has-been-used t) + ;; 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 org-frame-title-format-backup frame-title-format) + (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)) + (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)) + (setq org-clock-idle-timer + (run-with-timer 60 60 #'org-resolve-clocks-if-idle)) + (message "Clock starts at %s - %s" ts org--msg-extra) + (run-hooks 'org-clock-in-hook)))))) + +(defun org-clock-auto-clockout () + "Clock out the currently clocked in task if Emacs is idle. +See `org-clock-auto-clockout-timer' to set the idle time span. + +This is only effective when `org-clock-auto-clockout-insinuate' +is present in the user configuration." + (when (and (numberp org-clock-auto-clockout-timer) + org-clock-current-task) + (run-with-idle-timer + org-clock-auto-clockout-timer nil #'org-clock-out))) + +;;;###autoload +(defun org-clock-toggle-auto-clockout () + (interactive) + (if (memq 'org-clock-auto-clockout org-clock-in-hook) + (progn (remove-hook 'org-clock-in-hook #'org-clock-auto-clockout) + (message "Auto clock-out after idle time turned off")) + (add-hook 'org-clock-in-hook #'org-clock-auto-clockout t) + (message "Auto clock-out after idle time turned on"))) + +;;;###autoload +(defun org-clock-in-last (&optional arg) + "Clock in the last closed clocked item. +When already clocking in, send a 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 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)) + (org-current-time org-clock-rounding-minutes t)))) + (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." + (interactive) + (save-excursion + (org-back-to-heading t) + (move-marker org-clock-default-task (point)))) + +(defun org-clock-get-sum-start () + "Return the time from which clock times should be counted. + +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-mode-line-total' and then decides which time to use. + +The time is always returned as UTC." + (let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL" 'selective) + (symbol-name org-clock-mode-line-total))) + (lr (org-entry-get nil "LAST_REPEAT"))) + (cond + ((equal cmt "current") + (setq org--msg-extra "showing time in current clock instance") + (current-time)) + ((equal cmt "today") + (setq org--msg-extra "showing today's task time.") + (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) + (apply #'encode-time 0 0 (nthcdr 2 dt)))) + ((or (equal cmt "all") + (and (or (not cmt) (equal cmt "auto")) + (not lr))) + (setq org--msg-extra "showing entire task time.") + nil) + ((or (equal cmt "repeat") + (and (or (not cmt) (equal cmt "auto")) + lr)) + (setq org--msg-extra "showing task time since last repeat.") + (and lr (org-time-string-to-time lr))) + (t nil)))) + +(defun org-clock-find-position (find-unclosed) + "Find the location where the next clock line should be inserted. +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 (line-beginning-position)) + (end (save-excursion (outline-next-heading) (point))) + (org-clock-into-drawer (org-clock-into-drawer)) + (drawer (org-clock-drawer-name))) + ;; 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) + (let ((clock-re (concat "^[ \t]*" org-clock-string)) + (count 0) + positions) + ;; 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. + (org-end-of-meta-data) + (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)) + (org-flag-region + (line-end-position -1) (1- (point)) t 'outline) + (forward-line -1)))) + ;; When a clock drawer needs to be created because of the + ;; number of clock items or simply if it is missing, collect + ;; all clocks in the section and wrap them within the drawer. + ((if (wholenump org-clock-into-drawer) + (>= (1+ count) org-clock-into-drawer) + drawer) + ;; Skip planning line and property drawer, if any. + (org-end-of-meta-data) + (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-region (line-end-position) (1- end) t 'outline) + (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)))))))) + +(defun org-clock-restore-frame-title-format () + "Restore `frame-title-format' from `org-frame-title-format-backup'. +`frame-title-format' is restored if `org-frame-title-format-backup' is not nil +and current `frame-title-format' is equal to `org-clock-frame-title-format'." + (when (and org-frame-title-format-backup + (equal frame-title-format org-clock-frame-title-format)) + (setq frame-title-format org-frame-title-format-backup))) + +;;;###autoload +(defun org-clock-out (&optional switch-to-state fail-quietly at-time) + "Stop the currently running clock. +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)) + (org-clock-restore-frame-title-format) + (force-mode-line-update) + (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 (org-current-time org-clock-rounding-minutes)) + ts te s h m remove) + (setq org-clock-out-time (or at-time now)) + (save-excursion ; Do not replace this with `with-current-buffer'. + (with-no-warnings (set-buffer (org-clocking-buffer))) + (save-restriction + (widen) + (goto-char org-clock-marker) + (beginning-of-line 1) + (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) + (equal (match-string 1) org-clock-string)) + (setq ts (match-string 2)) + (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) + (goto-char (match-end 0)) + (delete-region (point) (point-at-eol)) + (insert "--") + (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) + (setq s (org-time-convert-to-integer + (time-subtract + (org-time-string-to-time te) + (org-time-string-to-time ts))) + h (floor s 3600) + m (floor (mod s 3600) 60)) + (insert " => " (format "%2d:%02d" h m)) + (move-marker org-clock-marker nil) + (move-marker org-clock-hd-marker nil) + ;; Possibly remove zero time clocks. + (when (and org-clock-out-remove-zero-time-clocks + (= 0 h m)) + (setq remove t) + (delete-region (line-beginning-position) + (line-beginning-position 2))) + (org-clock-remove-empty-clock-drawer) + (when org-clock-mode-line-timer + (cancel-timer org-clock-mode-line-timer) + (setq org-clock-mode-line-timer nil)) + (when org-clock-idle-timer + (cancel-timer org-clock-idle-timer) + (setq org-clock-idle-timer nil)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (org-clock-restore-frame-title-format) + (when org-clock-out-switch-to-state + (save-excursion + (org-back-to-heading t) + (let ((org-clock-out-when-done nil)) + (cond + ((functionp org-clock-out-switch-to-state) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) + (let ((newstate (funcall org-clock-out-switch-to-state + (match-string 2)))) + (when newstate (org-todo newstate)))) + ((and org-clock-out-switch-to-state + (not (looking-at (concat org-outline-regexp "[ \t]*" + org-clock-out-switch-to-state + "\\>")))) + (org-todo org-clock-out-switch-to-state)))))) + (force-mode-line-update) + (message (if remove + "Clock stopped at %s after %s => LINE REMOVED" + "Clock stopped at %s after %s") + te (org-duration-from-minutes (+ (* 60 h) m))) + (unless (org-clocking-p) + (setq org-clock-current-task nil)) + (run-hooks 'org-clock-out-hook) + ;; Add a note, but only if we didn't remove the clock line. + (when (and org-log-note-clock-out (not remove)) + (org-add-log-setup + 'clock-out nil nil nil + (concat "# Task: " (org-get-heading t) "\n\n")))))))) + +(defun org-clock-remove-empty-clock-drawer () + "Remove empty clock drawers in current subtree." + (save-excursion + (org-back-to-heading t) + (org-map-tree + (lambda () + (let ((drawer (org-clock-drawer-name)) + (case-fold-search t)) + (when drawer + (let ((re (format "^[ \t]*:%s:[ \t]*$" (regexp-quote drawer))) + (end (save-excursion (outline-next-heading)))) + (while (re-search-forward re end t) + (org-remove-empty-drawer-at (point)))))))))) + +(defun org-clock-timestamps-up (&optional n) + "Increase CLOCK timestamps at cursor. +Optional argument N tells to change by that many units." + (interactive "P") + (org-clock-timestamps-change 'up n)) + +(defun org-clock-timestamps-down (&optional n) + "Increase CLOCK timestamps at cursor. +Optional argument N tells to change by that many units." + (interactive "P") + (org-clock-timestamps-change 'down n)) + +(defun org-clock-timestamps-change (updown &optional n) + "Change CLOCK timestamps synchronously at cursor. +UPDOWN tells whether to change `up' or `down'. +Optional argument N tells to change by that many units." + (let ((tschange (if (eq updown 'up) 'org-timestamp-up + 'org-timestamp-down)) + (timestamp? (org-at-timestamp-p 'lax)) + ts1 begts1 ts2 begts2 updatets1 tdiff) + (when timestamp? + (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 n) + (funcall tschange n) + (let ((ts (if updatets1 ts2 ts1)) + (begts (if updatets1 begts1 begts2))) + (setq tdiff + (time-subtract + (org-time-string-to-time org-last-changed-timestamp) + (org-time-string-to-time ts))) + (save-excursion + (goto-char begts) + (org-timestamp-change + (round (/ (float-time tdiff) + (pcase timestamp? + (`minute 60) + (`hour 3600) + (`day (* 24 3600)) + (`month (* 24 3600 31)) + (`year (* 24 3600 365.2))))) + timestamp? '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)) + (org-clock-restore-frame-title-format) + (force-mode-line-update) + (user-error "No active clock")) + (save-excursion ; Do not replace this with `with-current-buffer'. + (with-no-warnings (set-buffer (org-clocking-buffer))) + (goto-char org-clock-marker) + (if (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 (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 org-clock-current-task nil) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (org-clock-restore-frame-title-format) + (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." + (interactive "@P") + (let* ((recent nil) + (m (cond + (select + (or (org-clock-select-task "Select task to go to: ") + (user-error "No task selected"))) + ((org-clocking-p) org-clock-marker) + ((and org-clock-goto-may-find-recent-task + (car org-clock-history) + (marker-buffer (car org-clock-history))) + (setq recent t) + (car org-clock-history)) + (t (user-error "No active or recent clock task"))))) + (pop-to-buffer-same-window (marker-buffer m)) + (if (or (< m (point-min)) (> m (point-max))) (widen)) + (goto-char m) + (org-show-entry) + (org-back-to-heading t) + (recenter org-clock-goto-before-context) + (org-reveal) + (if recent + (message "No running clock, this is the most recently clocked task")) + (run-hooks 'org-clock-goto-hook))) + +(defvar-local org-clock-file-total-minutes nil + "Holds the file total time in minutes, after a call to `org-clock-sum'.") + +;;;###autoload +(defun org-clock-sum-today (&optional headline-filter) + "Sum the times for each subtree for today." + (let ((range (org-clock-special-range '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) + "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. +PROPNAME lets you set a custom text property instead of :org-clock-minutes." + (with-silent-modifications + (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" + org-clock-string + "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) + (lmax 30) + (ltimes (make-vector lmax 0)) + (level 0) + (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart)) + ((consp tstart) (float-time tstart)) + (t tstart))) + (tend (cond ((stringp tend) (org-time-string-to-seconds tend)) + ((consp tend) (float-time tend)) + (t tend))) + (t1 0) + time) + (remove-text-properties (point-min) (point-max) + `(,(or propname :org-clock-minutes) t + :org-clock-force-headline-inclusion t)) + (save-excursion + (goto-char (point-max)) + (while (re-search-backward re nil t) + (cond + ((match-end 2) + ;; Two time stamps. + (let* ((ts (float-time + (apply #'encode-time + (save-match-data + (org-parse-time-string (match-string 2)))))) + (te (float-time + (apply #'encode-time + (org-parse-time-string (match-string 3))))) + (dt (- (if tend (min te tend) te) + (if tstart (max ts tstart) ts)))) + (when (> dt 0) (cl-incf t1 (floor dt 60))))) + ((match-end 4) + ;; A naked time. + (setq t1 (+ t1 (string-to-number (match-string 5)) + (* 60 (string-to-number (match-string 4)))))) + (t ;A headline + ;; Add the currently clocking item time to the total. + (when (and org-clock-report-include-clocking-task + (eq (org-clocking-buffer) (current-buffer)) + (eq (marker-position org-clock-hd-marker) (point)) + tstart + tend + (>= (float-time org-clock-start-time) tstart) + (<= (float-time org-clock-start-time) tend)) + (let ((time (floor (org-time-convert-to-integer + (org-time-since org-clock-start-time)) + 60))) + (setq t1 (+ t1 time)))) + (let* ((headline-forced + (get-text-property (point) + :org-clock-force-headline-inclusion)) + (headline-included + (or (null headline-filter) + (save-excursion + (save-match-data (funcall headline-filter)))))) + (setq level (- (match-end 1) (match-beginning 1))) + (when (>= 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 + (cl-loop for l from 0 to level do + (aset ltimes l (+ (aref ltimes l) t1)))) + (setq time (aref ltimes level)) + (goto-char (match-beginning 0)) + (put-text-property (point) (point-at-eol) + (or propname :org-clock-minutes) time) + (when headline-filter + (save-excursion + (save-match-data + (while (org-up-heading-safe) + (put-text-property + (point) (line-end-position) + :org-clock-force-headline-inclusion t)))))) + (setq t1 0) + (cl-loop for l from level to (1- lmax) do + (aset ltimes l 0))))))) + (setq org-clock-file-total-minutes (aref ltimes 0)))))) + +(defun org-clock-sum-current-item (&optional tstart) + "Return time, clocked on current item in total." + (save-excursion + (save-restriction + (if (and (featurep 'org-inlinetask) + (or (org-inlinetask-at-task-p) + (org-inlinetask-in-task-p))) + (narrow-to-region (save-excursion (org-inlinetask-goto-beginning) (point)) + (save-excursion (org-inlinetask-goto-end) (point))) + (org-narrow-to-subtree)) + (org-clock-sum tstart) + org-clock-file-total-minutes))) + +;;;###autoload +(defun org-clock-display (&optional arg) + "Show subtree times in the entire buffer. + +By default, show the total time for the range defined in +`org-clock-display-default-range'. With `\\[universal-argument]' \ +prefix, show +the total time for today instead. + +With `\\[universal-argument] \\[universal-argument]' prefix, \ +use a custom range, entered at prompt. + +With `\\[universal-argument] \ \\[universal-argument] \ +\\[universal-argument]' prefix, display the total time in the +echo area. + +Use `\\[org-clock-remove-overlays]' to remove the subtree times." + (interactive "P") + (org-clock-remove-overlays) + (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)))) + (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 (equal arg '(64)) + (save-excursion + (goto-char (point-min)) + (let ((p nil)) + (while (or (and (equal (setq p (point)) (point-min)) + (get-text-property p prop)) + (setq p (next-single-property-change (point) prop))) + (goto-char p) + (let ((time (get-text-property p prop))) + (when time (org-clock-put-overlay time))))) + ;; Arrange to remove the overlays upon next change. + (when org-remove-highlights-with-change + (add-hook 'before-change-functions #'org-clock-remove-overlays + nil 'local)))) + (let* ((h (/ org-clock-file-total-minutes 60)) + (m (- org-clock-file-total-minutes (* 60 h)))) + (message (cond + (todayp + "Total file time for today: %s (%d hours and %d minutes)") + (customp + "Total file time (custom): %s (%d hours and %d minutes)") + (t + "Total file time: %s (%d hours and %d minutes)")) + (org-duration-from-minutes org-clock-file-total-minutes) + h m)))) + +(defvar-local org-clock-overlays nil) + +(defun org-clock-put-overlay (time) + "Put an overlay on the headline at point, displaying TIME. +Create a new overlay and store it in `org-clock-overlays', so +that it will be easy to remove. This function assumes point is +on a headline." + (org-match-line org-complex-heading-regexp) + (goto-char (match-beginning 4)) + (let* ((headline (match-string 4)) + (text (concat headline + (org-add-props + (make-string + (max (- (- 60 (current-column)) + (org-string-width headline) + (length (org-get-at-bol 'line-prefix))) + 0) + ?\·) + '(face shadow)) + (org-add-props + (format " %9s " (org-duration-from-minutes time)) + '(face org-clock-overlay)))) + (o (make-overlay (point) (line-end-position)))) + (org-overlay-display o text) + (push o org-clock-overlays))) + +;;;###autoload +(defun org-clock-remove-overlays (&optional _beg _end noremove) + "Remove the occur highlights from the buffer. +If NOREMOVE is nil, remove this function from the +`before-change-functions' in the current buffer." + (interactive) + (unless org-inhibit-highlight-removal + (mapc #'delete-overlay org-clock-overlays) + (setq org-clock-overlays nil) + (unless noremove + (remove-hook 'before-change-functions + #'org-clock-remove-overlays 'local)))) + +;;;###autoload +(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-clocking-p) + org-clock-out-when-done + (marker-buffer org-clock-marker) + (or (and (eq t org-clock-out-when-done) + (member org-state org-done-keywords)) + (and (listp 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)) + (current-buffer))) + (< (point) org-clock-marker) + (> (org-with-wide-buffer (org-entry-end-position)) + org-clock-marker)) + ;; Clock out, but don't accept a logging message for this. + (let ((org-log-note-clock-out nil) + (org-clock-out-switch-to-state nil)) + (org-clock-out)))) + +;;;###autoload +(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." + ;; Set the defaults + (setq props (plist-put props :name "clocktable")) + (unless (plist-member props :maxlevel) + (setq props (plist-put props :maxlevel 2))) + (unless (plist-member props :scope) + (setq props (plist-put props :scope 'agenda))) + (with-temp-buffer + (org-mode) + (org-create-dblock props) + (org-update-dblock) + (org-font-lock-ensure) + (forward-line 2) + (buffer-substring (point) (progn + (re-search-forward "^[ \t]*#\\+END" nil t) + (point-at-bol))))) + +;;;###autoload +(defun org-clock-report (&optional arg) + "Update or create a table containing a report about clocked time. + +If point is inside an existing clocktable block, update it. +Otherwise, insert a new one. + +The new table inherits its properties from the variable +`org-clock-clocktable-default-properties'. The scope of the +clocktable, when not specified in the previous variable, is +`subtree' when the function is called from within a subtree, and +`file' elsewhere. + +When called with a prefix argument, move to the first clock table +in the buffer and update it." + (interactive "P") + (org-clock-remove-overlays) + (when arg + (org-find-dblock "clocktable") + (org-show-entry)) + (pcase (org-in-clocktable-p) + (`nil + (org-create-dblock + (org-combine-plists + (list :scope (if (org-before-first-heading-p) 'file 'subtree)) + org-clock-clocktable-default-properties + '(:name "clocktable")))) + (start (goto-char start))) + (org-update-dblock)) + +;;;###autoload +(eval-after-load 'org + '(progn + (org-dynamic-block-define "clocktable" #'org-clock-report))) + +(defun org-day-of-week (day month year) + "Return the day of the week as an integer." + (nth 6 + (decode-time + (date-to-time + (format "%d-%02d-%02dT00:00:00" year month day))))) + +(defun org-quarter-to-date (quarter year) + "Get the date (week day year) of the first day of a given quarter." + (let (startday) + (cond + ((= quarter 1) + (setq startday (org-day-of-week 1 1 year)) + (cond + ((= startday 0) + (list 52 7 (- year 1))) + ((= startday 6) + (list 52 6 (- year 1))) + ((<= startday 4) + (list 1 startday year)) + ((> startday 4) + (list 53 startday (- year 1))) + ) + ) + ((= quarter 2) + (setq startday (org-day-of-week 1 4 year)) + (cond + ((= startday 0) + (list 13 startday year)) + ((< startday 4) + (list 14 startday year)) + ((>= startday 4) + (list 13 startday year)) + ) + ) + ((= quarter 3) + (setq startday (org-day-of-week 1 7 year)) + (cond + ((= startday 0) + (list 26 startday year)) + ((< startday 4) + (list 27 startday year)) + ((>= startday 4) + (list 26 startday year)) + ) + ) + ((= quarter 4) + (setq startday (org-day-of-week 1 10 year)) + (cond + ((= startday 0) + (list 39 startday year)) + ((<= startday 4) + (list 40 startday year)) + ((> startday 4) + (list 39 startday year))))))) + +(defun org-clock-special-range (key &optional time as-strings 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' 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. Note that the first element is +always nil when KEY is `untilnow'. + +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)) + (skey (format "%s" key)) + (shift 0) + (q (cond ((>= month 10) 4) + ((>= month 7) 3) + ((>= month 4) 2) + (t 1))) + h1 d1 month1 y1 shiftedy shiftedm shiftedq) ;; m1 + (cond + ((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) + (require 'cal-iso) + (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 q (string-to-number (match-string 2 skey))) + (let ((date (calendar-gregorian-from-absolute + (calendar-iso-to-absolute + (org-quarter-to-date + q (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) + (setq shift (string-to-number (match-string 1 skey)) + 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) + (pcase 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. + (pcase key + ((or `day `today) (setq m 0 + h org-extend-today-until + h1 (+ 24 org-extend-today-until) + d (+ d shift))) + ((or `week `thisweek) + (let* ((ws (or wstart 1)) + (diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))))) + (setq m 0 h org-extend-today-until d (- d diff) d1 (+ 7 d)))) + ((or `month `thismonth) + (setq h org-extend-today-until m 0 d (or mstart 1) + month (+ month shift) month1 (1+ month))) + ((or `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 (cl-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 org-extend-today-until 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 org-extend-today-until d 1 + month (+ 1 qshift) month1 (+ 4 qshift)))))) + ((or `year `thisyear) + (setq m 0 h org-extend-today-until d 1 month 1 y (+ y shift) y1 (1+ y))) + ((or `interactive `untilnow)) ; Special cases, ignore them. + (_ (user-error "No such time block %s" key))) + ;; Format start and end times according to AS-STRINGS. + (let* ((start (pcase key + (`interactive (org-read-date nil t nil "Range start? ")) + (`untilnow nil) + (_ (encode-time 0 m h d month y)))) + (end (pcase key + (`interactive (org-read-date nil t nil "Range end? ")) + (`untilnow (current-time)) + (_ (encode-time 0 + m ;; (or m1 m) + (or h1 h) + (or d1 d) + (or month1 month) + (or y1 y))))) + (text + (pcase key + ((or `day `today) (format-time-string "%A, %B %d, %Y" start)) + ((or `week `thisweek) (format-time-string "week %G-W%V" start)) + ((or `month `thismonth) (format-time-string "%B %Y" start)) + ((or `year `thisyear) (format-time-string "the year %Y" start)) + ((or `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 (and start (format-time-string f start)) + (format-time-string f end) + text)))))) + +(defun org-count-quarter (n) + (cond + ((= n 1) "1st") + ((= n 2) "2nd") + ((= n 3) "3rd") + ((= n 4) "4th"))) + +;;;###autoload +(defun org-clocktable-shift (dir n) + "Try to shift the :block date of the clocktable at point. +Point must be in the #+BEGIN: line of a clocktable, or this function +will throw an error. +DIR is a direction, a symbol `left', `right', `up', or `down'. +Both `left' and `down' shift the block toward the past, `up' and `right' +push it toward the future. +N is the number of shift steps to take. The size of the step depends on +the currently selected interval size." + (setq n (prefix-numeric-value n)) + (and (memq dir '(left down)) (setq n (- n))) + (save-excursion + (goto-char (point-at-bol)) + (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) + (user-error "Line needs a :block definition before this command works") + (let* ((b (match-beginning 1)) (e (match-end 1)) + (s (match-string 1)) + block shift ins y mw d date wp) ;; m + (cond + ((equal s "yesterday") (setq s "today-1")) + ((equal s "lastweek") (setq s "thisweek-1")) + ((equal s "lastmonth") (setq s "thismonth-1")) + ((equal s "lastyear") (setq s "thisyear-1")) + ((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) nil y)))) ;; m + ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) + (require 'cal-iso) + (setq date (calendar-gregorian-from-absolute + (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))))) + ((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-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))))) + (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 (user-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)) + (catch 'exit + (let* ((scope (plist-get params :scope)) + (base-buffer (org-base-buffer (current-buffer))) + (files (pcase scope + (`agenda + (org-agenda-files t)) + (`agenda-with-archives + (org-add-archive-files (org-agenda-files t))) + (`file-with-archives + (let ((base-file (buffer-file-name base-buffer))) + (and base-file + (org-add-archive-files (list base-file))))) + ((or `nil `file `subtree `tree + (and (pred symbolp) + (guard (string-match "\\`tree\\([0-9]+\\)\\'" + (symbol-name scope))))) + base-buffer) + ((pred functionp) (funcall scope)) + ((pred consp) scope) + (_ (user-error "Unknown scope: %S" scope)))) + (block (plist-get params :block)) + (ts (plist-get params :tstart)) + (te (plist-get params :tend)) + (ws (plist-get params :wstart)) + (ms (plist-get params :mstart)) + (step (plist-get params :step)) + (hide-files (plist-get params :hidefiles)) + (formatter (or (plist-get params :formatter) + org-clock-clocktable-formatter + 'org-clocktable-write-default)) + cc) + ;; Check if we need to do steps + (when block + ;; Get the range text for the header + (setq cc (org-clock-special-range block nil t ws ms) + ts (car cc) + te (nth 1 cc))) + (when step + ;; Write many tables, in steps + (unless (or block (and ts te)) + (user-error "Clocktable `:step' can only be used with `:block' or `:tstart, :end'")) + (org-clocktable-steps params) + (throw 'exit nil)) + + (org-agenda-prepare-buffers (if (consp files) files (list files))) + + (let ((origin (point)) + (tables + (if (consp files) + (mapcar (lambda (file) + (with-current-buffer (find-buffer-visiting file) + (save-excursion + (save-restriction + (org-clock-get-table-data file params))))) + files) + ;; Get the right restriction for the scope. + (save-restriction + (cond + ((not scope)) ;use the restriction as it is now + ((eq scope 'file) (widen)) + ((eq scope 'subtree) (org-narrow-to-subtree)) + ((eq scope 'tree) + (while (org-up-heading-safe)) + (org-narrow-to-subtree)) + ((and (symbolp scope) + (string-match "\\`tree\\([0-9]+\\)\\'" + (symbol-name scope))) + (let ((level (string-to-number + (match-string 1 (symbol-name scope))))) + (catch 'exit + (while (org-up-heading-safe) + (looking-at org-outline-regexp) + (when (<= (org-reduced-level (funcall outline-level)) + level) + (throw 'exit nil)))) + (org-narrow-to-subtree)))) + (list (org-clock-get-table-data nil params))))) + (multifile + ;; Even though `file-with-archives' can consist of + ;; multiple files, we consider this is one extended file + ;; instead. + (and (not hide-files) + (consp files) + (not (eq scope 'file-with-archives))))) + + (funcall formatter + origin + tables + (org-combine-plists params `(:multifile ,multifile))))))) + +(defun org-clocktable-write-default (ipos tables params) + "Write out a clock table at position IPOS in the current buffer. +TABLES is a list of tables with clocking data as produced by +`org-clock-get-table-data'. PARAMS is the parameter property list obtained +from the dynamic block 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* ((lang (or (plist-get params :lang) "en")) + (multifile (plist-get params :multifile)) + (block (plist-get params :block)) + (sort (plist-get params :sort)) + (header (plist-get params :header)) + (link (plist-get params :link)) + (maxlevel (or (plist-get params :maxlevel) 3)) + (emph (plist-get params :emphasize)) + (compact? (plist-get params :compact)) + (narrow (or (plist-get params :narrow) (and compact? '40!))) + (level? (and (not compact?) (plist-get params :level))) + (timestamp (plist-get params :timestamp)) + (tags (plist-get params :tags)) + (properties (plist-get params :properties)) + (time-columns + (if (or compact? (< maxlevel 2)) 1 + ;; Deepest headline level is a hard limit for the number + ;; of time columns. + (let ((levels + (cl-mapcan + (lambda (table) + (pcase table + (`(,_ ,(and (pred wholenump) (pred (/= 0))) ,entries) + (mapcar #'car entries)))) + tables))) + (min maxlevel + (or (plist-get params :tcolumns) 100) + (if (null levels) 1 (apply #'max levels)))))) + (indent (or compact? (plist-get params :indent))) + (formula (plist-get params :formula)) + (case-fold-search t) + (total-time (apply #'+ (mapcar #'cadr tables))) + recalc narrow-cut-p) + + (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)))) + + (pcase narrow + ((or `nil (pred integerp)) nil) ;nothing to do + ((and (pred symbolp) + (guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow)))) + (setq narrow-cut-p t) + (setq narrow (string-to-number (symbol-name narrow)))) + (_ (user-error "Invalid value %s of :narrow property in clock table" narrow))) + + ;; Now we need to output this table stuff. + (goto-char ipos) + + ;; Insert the text *before* the actual table. + (insert-before-markers + (or header + ;; Format the standard header. + (format "#+CAPTION: %s %s%s\n" + (org-clock--translate "Clock summary at" lang) + (format-time-string (org-time-stamp-format t t)) + (if block + (let ((range-text + (nth 2 (org-clock-special-range + block nil t + (plist-get params :wstart) + (plist-get params :mstart))))) + (format ", for %s." range-text)) + "")))) + + ;; 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? "|" "") ;level column, maybe + (if timestamp "|" "") ;timestamp column, maybe + (if tags "|" "") ;tags columns, maybe + (if properties ;properties columns, maybe + (make-string (length properties) ?|) + "") + (format "<%d>| |\n" narrow))) ;headline and time columns + + ;; Insert the table header line + (insert-before-markers + "|" ;table line starter + (if multifile ;file column, maybe + (concat (org-clock--translate "File" lang) "|") + "") + (if level? ;level column, maybe + (concat (org-clock--translate "L" lang) "|") + "") + (if timestamp ;timestamp column, maybe + (concat (org-clock--translate "Timestamp" lang) "|") + "") + (if tags "Tags |" "") ;tags columns, maybe + + (if properties ;properties columns, maybe + (concat (mapconcat #'identity properties "|") "|") + "") + (concat (org-clock--translate "Headline" lang)"|") + (concat (org-clock--translate "Time" lang) "|") + (make-string (max 0 (1- time-columns)) ?|) ;other time columns + (if (eq formula '%) "%|\n" "\n")) + + ;; Insert the total time in the table + (insert-before-markers + "|-\n" ;a hline + "|" ;table line starter + (if multifile (format "| %s " (org-clock--translate "ALL" lang)) "") + ;file column, maybe + (if level? "|" "") ;level column, maybe + (if timestamp "|" "") ;timestamp column, maybe + (if tags "|" "") ;timestamp column, maybe + (make-string (length properties) ?|) ;properties columns, maybe + (concat (format org-clock-total-time-cell-format + (org-clock--translate "Total time" lang)) + "| ") + (format org-clock-total-time-cell-format + (org-duration-from-minutes (or total-time 0))) ;time + "|" + (make-string (max 0 (1- time-columns)) ?|) + (cond ((not (eq formula '%)) "") + ((or (not total-time) (= total-time 0)) "0.0|") + (t "100.0|")) + "\n") + + ;; Now iterate over the tables and insert the data but only if any + ;; time has been collected. + (when (and total-time (> total-time 0)) + (pcase-dolist (`(,file-name ,file-time ,entries) tables) + (when (or (and file-time (> file-time 0)) + (not (plist-get params :fileskip0))) + (insert-before-markers "|-\n") ;hline at new file + ;; 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%s" + (format org-clock-file-time-cell-format + (org-clock--translate "File time" lang)) + + ;; The file-time rollup value goes in the first time + ;; column (of which there is always at least one)... + " | *%s*|" + ;; ...and the remaining file time cols (if any) are blank. + (make-string (max 0 (1- time-columns)) ?|) + + ;; Optionally show the percentage contribution of "this" + ;; file time to the total time. + (if (eq formula '%) " %s |" "") + "\n") + + (file-name-nondirectory file-name) + (if level? "| " "") ;level column, maybe + (if timestamp "| " "") ;timestamp column, maybe + (if tags "| " "") ;tags column, maybe + (if properties ;properties columns, maybe + (make-string (length properties) ?|) + "") + (org-duration-from-minutes file-time) ;time + + (cond ((not (eq formula '%)) "") ;time percentage, maybe + ((or (not total-time) (= total-time 0)) "0.0") + (t + (format "%.1f" (* 100 (/ file-time (float total-time))))))))) + + ;; Get the list of node entries and iterate over it + (when (> maxlevel 0) + (pcase-dolist (`(,level ,headline ,tgs ,ts ,time ,props) entries) + (when narrow-cut-p + (setq headline + (if (and (string-match + (format "\\`%s\\'" org-link-bracket-re) + headline) + (match-end 2)) + (format "[[%s][%s]]" + (match-string 1 headline) + (org-shorten-string (match-string 2 headline) + narrow)) + (org-shorten-string headline narrow)))) + (cl-flet ((format-field (f) (format (cond ((not emph) "%s |") + ((= level 1) "*%s* |") + ((= level 2) "/%s/ |") + (t "%s |")) + f))) + (insert-before-markers + "|" ;start the table line + (if multifile "|" "") ;free space for file name column? + (if level? (format "%d|" level) "") ;level, maybe + (if timestamp (concat ts "|") "") ;timestamp, maybe + (if tags (concat (mapconcat #'identity tgs ", ") "|") "") ;tags, maybe + (if properties ;properties columns, maybe + (concat (mapconcat (lambda (p) (or (cdr (assoc p props)) "")) + properties + "|") + "|") + "") + (if indent ;indentation + (org-clocktable-indent-string level) + "") + (format-field headline) + ;; Empty fields for higher levels. + (make-string (max 0 (1- (min time-columns level))) ?|) + (format-field (org-duration-from-minutes time)) + (make-string (max 0 (- time-columns level)) ?|) + (if (eq formula '%) + (format "%.1f |" (* 100 (/ time (float total-time)))) + "") + "\n"))))))) + (delete-char -1) + (cond + ;; Possibly rescue old formula? + ((or (not formula) (eq formula '%)) + (let ((contents (org-string-nw-p (plist-get params :content)))) + (when (and contents (string-match "^\\([ \t]*#\\+tblfm:.*\\)" contents)) + (setq recalc t) + (insert "\n" (match-string 1 contents)) + (beginning-of-line 0)))) + ;; Insert specified formula line. + ((stringp formula) + (insert "\n#+TBLFM: " formula) + (setq recalc t)) + (t + (user-error "Invalid :formula parameter in clocktable"))) + ;; 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 sort + (save-excursion + (org-table-goto-line 3) + (org-table-goto-column (car sort)) + (org-table-sort-lines nil (cdr sort)))) + (when recalc (org-table-recalculate 'all)) + 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) "" + (concat "\\_" (make-string (* 2 (1- level)) ?\s)))) + +(defun org-clocktable-steps (params) + "Create one or more clock tables, according to PARAMS. +Step through the range specifications in plist PARAMS to make +a number of clock tables." + (let* ((ignore-empty-tables (plist-get params :stepskip0)) + (step (plist-get params :step)) + (step-header + (pcase step + (`day "Daily report: ") + (`week "Weekly report starting on: ") + (`semimonth "Semimonthly report starting on: ") + (`month "Monthly report starting on: ") + (`year "Annual report starting on: ") + (_ (user-error "Unknown `:step' specification: %S" step)))) + (week-start (or (plist-get params :wstart) 1)) + (month-start (or (plist-get params :mstart) 1)) + (range + (pcase (plist-get params :block) + (`nil nil) + (range + (org-clock-special-range range nil t week-start month-start)))) + ;; For both START and END, any number is an absolute day + ;; number from Agenda. Otherwise, consider value to be an Org + ;; timestamp string. The `:block' property has precedence + ;; over `:tstart' and `:tend'. + (start + (pcase (if range (car range) (plist-get params :tstart)) + ((and (pred numberp) n) + (pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n))) + (apply #'encode-time (list 0 0 org-extend-today-until d m y)))) + (timestamp + (seconds-to-time + (org-matcher-time (or timestamp + ;; The year Org was born. + "<2003-01-01 Thu 00:00>")))))) + (end + (pcase (if range (nth 1 range) (plist-get params :tend)) + ((and (pred numberp) n) + (pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n))) + (apply #'encode-time (list 0 0 org-extend-today-until d m y)))) + (timestamp (seconds-to-time (org-matcher-time timestamp)))))) + (while (time-less-p start end) + (unless (bolp) (insert "\n")) + ;; Insert header before each clock table. + (insert "\n" + step-header + (format-time-string (org-time-stamp-format nil t) start) + "\n") + ;; Compute NEXT, which is the end of the current clock table, + ;; according to step. + (let* ((next + (apply #'encode-time + (pcase-let + ((`(,_ ,_ ,_ ,d ,m ,y ,dow . ,_) (decode-time start))) + (pcase step + (`day (list 0 0 org-extend-today-until (1+ d) m y)) + (`week + (let ((offset (if (= dow week-start) 7 + (mod (- week-start dow) 7)))) + (list 0 0 org-extend-today-until (+ d offset) m y))) + (`semimonth (list 0 0 0 + (if (< d 16) 16 1) + (if (< d 16) m (1+ m)) y)) + (`month (list 0 0 0 month-start (1+ m) y)) + (`year (list 0 0 org-extend-today-until 1 1 (1+ y))))))) + (table-begin (line-beginning-position 0)) + (step-time + ;; Write clock table between START and NEXT. + (org-dblock-write:clocktable + (org-combine-plists + params (list :header "" + :step nil + :block nil + :tstart (format-time-string + (org-time-stamp-format t t) + start) + :tend (format-time-string + (org-time-stamp-format t t) + ;; Never include clocks past END. + (if (time-less-p end next) end next))))))) + (let ((case-fold-search t)) (re-search-forward "^[ \t]*#\\+END:")) + ;; Remove the table if it is empty and `:stepskip0' is + ;; non-nil. + (when (and ignore-empty-tables (equal step-time 0)) + (delete-region (line-beginning-position) table-begin)) + (setq start next)) + (end-of-line 0)))) + +(defun org-clock-get-table-data (file params) + "Get the clocktable data for file FILE, with parameters PARAMS. +FILE is only for identification - this function assumes that +the correct buffer is current, and that the wanted restriction is +in place. +The return value will be a list with the file name and the total +file time (in minutes) as 1st and 2nd elements. The third element +of this list will be a list of headline entries. Each entry has the +following structure: + + (LEVEL HEADLINE TAGS TIMESTAMP TIME PROPERTIES) + +LEVEL: The level of the headline, as an integer. This will be + the reduced level, so 1,2,3,... even if only odd levels + are being used. +HEADLINE: The text of the headline. Depending on PARAMS, this may + already be formatted like a link. +TAGS: The list of tags of the headline. +TIMESTAMP: If PARAMS require it, this will be a time stamp found in the + entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive, + in this sequence. +TIME: The sum of all time spend in this tree, in minutes. This time + will of cause be restricted to the time block and tags match + specified in PARAMS. +PROPERTIES: The list properties specified in the `:properties' parameter + along with their value, as an alist following the pattern + (NAME . VALUE)." + (let* ((maxlevel (or (plist-get params :maxlevel) 3)) + (timestamp (plist-get params :timestamp)) + (ts (plist-get params :tstart)) + (te (plist-get params :tend)) + (ws (plist-get params :wstart)) + (ms (plist-get params :mstart)) + (block (plist-get params :block)) + (link (plist-get params :link)) + (tags (plist-get params :tags)) + (match (plist-get params :match)) + (properties (plist-get params :properties)) + (inherit-property-p (plist-get params :inherit-props)) + (matcher (and match (cdr (org-make-tags-matcher match)))) + cc st p tbl) + + (setq org-clock-file-total-minutes nil) + (when block + (setq cc (org-clock-special-range block nil t ws ms) + ts (car cc) + te (nth 1 cc))) + (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts))) + (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) + (when (and ts (listp ts)) + (setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts)))) + (when (and te (listp te)) + (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) + ;; Now the times are strings we can parse. + (if ts (setq ts (org-matcher-time ts))) + (if te (setq te (org-matcher-time te))) + (save-excursion + (org-clock-sum ts te + (when matcher + (lambda () + (let* ((todo (org-get-todo-state)) + (tags-list (org-get-tags)) + (org-scanner-tags tags-list) + (org-trust-scanner-tags t)) + (funcall matcher todo tags-list nil))))) + (goto-char (point-min)) + (setq st t) + (while (or (and (bobp) (prog1 st (setq st nil)) + (get-text-property (point) :org-clock-minutes) + (setq p (point-min))) + (setq p (next-single-property-change + (point) :org-clock-minutes))) + (goto-char p) + (let ((time (get-text-property p :org-clock-minutes))) + (when (and time (> time 0) (org-at-heading-p)) + (let ((level (org-reduced-level (org-current-level)))) + (when (<= level maxlevel) + (let* ((headline (org-get-heading t t t t)) + (hdl + (if (not link) headline + (let ((search + (org-link-heading-search-string headline))) + (org-link-make-string + (if (not (buffer-file-name)) search + (format "file:%s::%s" (buffer-file-name) search)) + ;; Prune statistics cookies. Replace + ;; links with their description, or + ;; a plain link if there is none. + (org-trim + (org-link-display-format + (replace-regexp-in-string + "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" "" + headline))))))) + (tgs (and tags (org-get-tags))) + (tsp + (and timestamp + (cl-some (lambda (p) (org-entry-get (point) p)) + '("SCHEDULED" "DEADLINE" "TIMESTAMP" + "TIMESTAMP_IA")))) + (props + (and properties + (delq nil + (mapcar + (lambda (p) + (let ((v (org-entry-get + (point) p inherit-property-p))) + (and v (cons p v)))) + properties))))) + (push (list level hdl tgs tsp time props) tbl))))))) + (list file org-clock-file-total-minutes (nreverse tbl))))) + +;; Saving and loading the clock + +(defvar org-clock-loaded nil + "Was the clock file loaded?") + +;;;###autoload +(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 + (org-time-string-to-time (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 (- (float-time + (apply #'encode-time (org-parse-time-string te))) + (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 +`org-clock-persist'." + (when (and org-clock-persist + (or org-clock-loaded + org-clock-has-been-used + (not (file-exists-p org-clock-persist-file)))) + (with-temp-file org-clock-persist-file + (insert (format ";; %s - %s at %s\n" + (file-name-nondirectory org-clock-persist-file) + (system-name) + (format-time-string (org-time-stamp-format t)))) + ;; Store clock to be resumed. + (when (and (memq org-clock-persist '(t clock)) + (let ((b (org-base-buffer (org-clocking-buffer)))) + (and (buffer-live-p b) + (buffer-file-name b) + (or (not org-clock-persist-query-save) + (y-or-n-p (format "Save current clock (%s) " + org-clock-heading)))))) + (insert + (format "(setq org-clock-stored-resume-clock '(%S . %d))\n" + (buffer-file-name (org-base-buffer (org-clocking-buffer))) + (marker-position org-clock-marker)))) + ;; Store clocked task history. Tasks are stored reversed to + ;; make reading simpler. + (when (and (memq org-clock-persist '(t history)) + org-clock-history) + (insert + (format "(setq org-clock-stored-history '(%s))\n" + (mapconcat + (lambda (m) + (let ((b (org-base-buffer (marker-buffer m)))) + (when (and (buffer-live-p b) + (buffer-file-name b)) + (format "(%S . %d)" + (buffer-file-name b) + (marker-position m))))) + (reverse org-clock-history) + " "))))))) + +(defun org-clock-load () + "Load clock-related data from disk, maybe resuming a stored clock." + (when (and org-clock-persist (not org-clock-loaded)) + (if (not (file-readable-p org-clock-persist-file)) + (message "Not restoring clock data; %S not found" org-clock-persist-file) + (message "Restoring clock data") + ;; Load history. + (load-file org-clock-persist-file) + (setq org-clock-loaded t) + (pcase-dolist (`(,(and file (pred file-exists-p)) . ,position) + org-clock-stored-history) + (org-clock-history-push position (find-file-noselect file))) + ;; Resume clock. + (pcase org-clock-stored-resume-clock + (`(,(and file (pred file-exists-p)) . ,position) + (with-current-buffer (find-file-noselect file) + (when (or (not org-clock-persist-query-resume) + (y-or-n-p (format "Resume clock (%s) " + (save-excursion + (goto-char position) + (org-get-heading t t))))) + (goto-char position) + (let ((org-clock-in-resume 'auto-restart) + (org-clock-auto-clock-resolution nil)) + (org-clock-in) + (when (org-invisible-p) (org-show-context)))))) + (_ nil))))) + +(defun org-clock-kill-emacs-query () + "Query user when killing Emacs. +This function is added to `kill-emacs-query-functions'." + (let ((buf (org-clocking-buffer))) + (when (and buf (yes-or-no-p "Clock out and save? ")) + (with-current-buffer buf + (org-clock-out) + (save-buffer)))) + ;; Unconditionally return t for `kill-emacs-query-functions'. + t) + +;; 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" +;; coding: utf-8 +;; End: + +;;; org-clock.el ends here |