config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

org-clock.el (128495B)


      1 ;;; org-clock.el --- The time clocking code for Org mode -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2004-2024 Free Software Foundation, Inc.
      4 
      5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
      6 ;; Keywords: outlines, hypermedia, calendar, text
      7 ;; URL: https://orgmode.org
      8 ;;
      9 ;; This file is part of GNU Emacs.
     10 ;;
     11 ;; GNU Emacs is free software: you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation, either version 3 of the License, or
     14 ;; (at your option) any later version.
     15 
     16 ;; GNU Emacs is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     24 ;;
     25 ;;; Commentary:
     26 
     27 ;; This file contains the time clocking code for Org mode
     28 
     29 ;;; Code:
     30 
     31 (require 'org-macs)
     32 (org-assert-version)
     33 
     34 (require 'cl-lib)
     35 (require 'org)
     36 
     37 (declare-function calendar-iso-to-absolute "cal-iso" (date))
     38 (declare-function notifications-notify "notifications" (&rest params))
     39 (declare-function org-element-property "org-element-ast" (property node))
     40 (declare-function org-element-contents-end "org-element" (node))
     41 (declare-function org-element-end "org-element" (node))
     42 (declare-function org-element-type "org-element-ast" (node &optional anonymous))
     43 (declare-function org-element-type-p "org-element-ast" (node types))
     44 (defvar org-element-use-cache)
     45 (declare-function org-inlinetask-at-task-p "org-inlinetask" ())
     46 (declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
     47 (declare-function org-inlinetask-goto-end "org-inlinetask" ())
     48 (declare-function org-inlinetask-in-task-p "org-inlinetask" ())
     49 (declare-function org-link-display-format "ol" (s))
     50 (declare-function org-link-heading-search-string "ol" (&optional string))
     51 (declare-function org-link-make-string "ol" (link &optional description))
     52 (declare-function org-table-goto-line "org-table" (n))
     53 (declare-function org-dynamic-block-define "org" (type func))
     54 (declare-function w32-notification-notify "w32fns.c" (&rest params))
     55 (declare-function w32-notification-close "w32fns.c" (&rest params))
     56 (declare-function dbus-list-activatable-names "dbus" (&optional bus))
     57 (declare-function dbus-call-method "dbus" (bus service path interface method &rest args))
     58 (declare-function dbus-get-property "dbus" (bus service path interface property))
     59 (declare-function haiku-notifications-notify "haikuselect.c")
     60 (declare-function android-notifications-notify "androidselect.c")
     61 
     62 (defvar org-frame-title-format-backup nil)
     63 (defvar org-state)
     64 (defvar org-link-bracket-re)
     65 
     66 (defgroup org-clock nil
     67   "Options concerning clocking working time in Org mode."
     68   :tag "Org Clock"
     69   :group 'org-progress)
     70 
     71 (defcustom org-clock-into-drawer t
     72   "Non-nil when clocking info should be wrapped into a drawer.
     73 
     74 When non-nil, clocking info will be inserted into the same drawer
     75 as log notes (see variable `org-log-into-drawer'), if it exists,
     76 or \"LOGBOOK\" otherwise.  If necessary, the drawer will be
     77 created.
     78 
     79 When an integer, the drawer is created only when the number of
     80 clocking entries in an item reaches or exceeds this value.
     81 
     82 When a string, it becomes the name of the drawer, ignoring the
     83 log notes drawer altogether.
     84 
     85 Do not check directly this variable in a Lisp program.  Call
     86 function `org-clock-into-drawer' instead."
     87   :group 'org-todo
     88   :group 'org-clock
     89   :version "26.1"
     90   :package-version '(Org . "8.3")
     91   :type '(choice
     92 	  (const :tag "Always" t)
     93 	  (const :tag "Only when drawer exists" nil)
     94 	  (integer :tag "When at least N clock entries")
     95 	  (const :tag "Into LOGBOOK drawer" "LOGBOOK")
     96 	  (string :tag "Into Drawer named...")))
     97 
     98 (defun org-clock-into-drawer ()
     99   "Value of `org-clock-into-drawer', but let properties overrule.
    100 
    101 If the current entry has or inherits a CLOCK_INTO_DRAWER
    102 property, it will be used instead of the default value.
    103 
    104 Return value is either a string, an integer, or nil."
    105   (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit t)))
    106     (cond ((equal p "nil") nil)
    107 	  ((equal p "t") (or (org-log-into-drawer) "LOGBOOK"))
    108           ((org-string-nw-p p)
    109 	   (if (string-match-p "\\`[0-9]+\\'" p) (string-to-number p) p))
    110 	  ((org-string-nw-p org-clock-into-drawer))
    111 	  ((integerp org-clock-into-drawer) org-clock-into-drawer)
    112 	  ((not org-clock-into-drawer) nil)
    113 	  ((org-log-into-drawer))
    114 	  (t "LOGBOOK"))))
    115 
    116 (defcustom org-clock-out-when-done t
    117   "When non-nil, clock will be stopped when the clocked entry is marked DONE.
    118 \\<org-mode-map>\
    119 DONE here means any DONE-like state.
    120 A nil value means clock will keep running until stopped explicitly with
    121 `\\[org-clock-out]', or until the clock is started in a different item.
    122 Instead of t, this can also be a list of TODO states that should trigger
    123 clocking out."
    124   :group 'org-clock
    125   :type '(choice
    126 	  (const :tag "No" nil)
    127 	  (const :tag "Yes, when done" t)
    128 	  (repeat :tag "State list"
    129 		  (string :tag "TODO keyword"))))
    130 
    131 (defcustom org-clock-rounding-minutes 0
    132   "Rounding minutes when clocking in or out.
    133 The default value is 0 so that no rounding is done.
    134 When set to a non-integer value, use the car of
    135 `org-timestamp-rounding-minutes', like for setting a timestamp.
    136 
    137 E.g. if `org-clock-rounding-minutes' is set to 5, time is 14:47
    138 and you clock in: then the clock starts at 14:45.  If you clock
    139 out within the next 5 minutes, the clock line will be removed;
    140 if you clock out 8 minutes after your clocked in, the clock
    141 out time will be 14:50."
    142   :group 'org-clock
    143   :version "24.4"
    144   :package-version '(Org . "8.0")
    145   :type '(choice
    146 	  (integer :tag "Minutes (0 for no rounding)")
    147 	  (symbol  :tag "Use `org-time-stamp-rounding-minutes'" 'same-as-time-stamp)))
    148 
    149 (defcustom org-clock-out-remove-zero-time-clocks nil
    150   "Non-nil means remove the clock line when the resulting time is zero."
    151   :group 'org-clock
    152   :type 'boolean)
    153 
    154 (defcustom org-clock-in-switch-to-state nil
    155   "Set task to a special todo state while clocking it.
    156 The value should be the state to which the entry should be
    157 switched.  If the value is a function, it must take one
    158 parameter (the current TODO state of the item) and return the
    159 state to switch it to."
    160   :group 'org-clock
    161   :group 'org-todo
    162   :type '(choice
    163 	  (const :tag "Don't force a state" nil)
    164 	  (string :tag "State")
    165 	  (symbol :tag "Function")))
    166 
    167 (defcustom org-clock-out-switch-to-state nil
    168   "Set task to a special todo state after clocking out.
    169 The value should be the state to which the entry should be
    170 switched.  If the value is a function, it must take one
    171 parameter (the current TODO state of the item) and return the
    172 state to switch it to."
    173   :group 'org-clock
    174   :group 'org-todo
    175   :type '(choice
    176 	  (const :tag "Don't force a state" nil)
    177 	  (string :tag "State")
    178 	  (symbol :tag "Function")))
    179 
    180 (defcustom org-clock-history-length 5
    181   "Number of clock tasks to remember in history.
    182 Clocking in using history works best if this is at most 35, in
    183 which case all digits and capital letters are used up by the
    184 *Clock Task Select* buffer."
    185   :group 'org-clock
    186   :type 'integer)
    187 
    188 (defcustom org-clock-goto-may-find-recent-task t
    189   "Non-nil means `org-clock-goto' can go to recent task if no active clock."
    190   :group 'org-clock
    191   :type 'boolean)
    192 
    193 (defcustom org-clock-heading-function nil
    194   "When non-nil, should be a function to create `org-clock-heading'.
    195 This is the string shown in the mode line when a clock is running.
    196 The function is called with point at the beginning of the headline."
    197   :group 'org-clock
    198   :type '(choice (const nil) (function)))
    199 
    200 (defcustom org-clock-string-limit 0
    201   "Maximum length of clock strings in the mode line.  0 means no limit."
    202   :group 'org-clock
    203   :type 'integer)
    204 
    205 (defcustom org-clock-in-resume nil
    206   "If non-nil, resume clock when clocking into task with open clock.
    207 When clocking into a task with a clock entry which has not been closed,
    208 the clock can be resumed from that point."
    209   :group 'org-clock
    210   :type 'boolean)
    211 
    212 (defcustom org-clock-persist nil
    213   "When non-nil, save the running clock when Emacs is closed.
    214 The clock is resumed when Emacs restarts.
    215 When this is t, both the running clock, and the entire clock
    216 history are saved.  When this is the symbol `clock', only the
    217 running clock is saved.  When this is the symbol `history', only
    218 the clock history is saved.
    219 
    220 When Emacs restarts with saved clock information, the file containing
    221 the running clock as well as all files mentioned in the clock history
    222 will be visited.
    223 
    224 All this depends on running `org-clock-persistence-insinuate' in your
    225 Emacs initialization file."
    226   :group 'org-clock
    227   :type '(choice
    228 	  (const :tag "Just the running clock" clock)
    229 	  (const :tag "Just the history" history)
    230 	  (const :tag "Clock and history" t)
    231 	  (const :tag "No persistence" nil)))
    232 
    233 (defcustom org-clock-persist-file (locate-user-emacs-file "org-clock-save.el")
    234   "File to save clock data to."
    235   :group 'org-clock
    236   :type 'string)
    237 
    238 (defcustom org-clock-persist-query-save nil
    239   "When non-nil, ask before saving the current clock on exit."
    240   :group 'org-clock
    241   :type 'boolean)
    242 
    243 (defcustom org-clock-persist-query-resume t
    244   "When non-nil, ask before resuming any stored clock during load."
    245   :group 'org-clock
    246   :type 'boolean)
    247 
    248 (defcustom org-clock-sound nil
    249   "Sound to use for notifications.
    250 Possible values are:
    251 
    252 nil        No sound played
    253 t          Standard Emacs beep
    254 file name  Play this sound file, fall back to beep"
    255   :group 'org-clock
    256   :type '(choice
    257 	  (const :tag "No sound" nil)
    258 	  (const :tag "Standard beep" t)
    259 	  (file  :tag "Play sound file")))
    260 
    261 (defcustom org-clock-mode-line-total 'auto
    262   "Default setting for the time included for the mode line clock.
    263 This can be overruled locally using the CLOCK_MODELINE_TOTAL property.
    264 Allowed values are:
    265 
    266 current  Only the time in the current instance of the clock
    267 today    All time clocked into this task today
    268 repeat   All time clocked into this task since last repeat
    269 all      All time ever recorded for this task
    270 auto     Automatically, either `all', or `repeat' for repeating tasks"
    271   :group 'org-clock
    272   :type '(choice
    273 	  (const :tag "Current clock" current)
    274 	  (const :tag "Today's task time" today)
    275 	  (const :tag "Since last repeat" repeat)
    276 	  (const :tag "All task time" all)
    277 	  (const :tag "Automatically, `all' or since `repeat'" auto)))
    278 
    279 (defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
    280 (defcustom org-clock-task-overrun-text nil
    281   "Extra mode line text to indicate that the clock is overrun.
    282 The can be nil to indicate that instead of adding text, the clock time
    283 should get a different face (`org-mode-line-clock-overrun').
    284 When this is a string, it is prepended to the clock string as an indication,
    285 also using the face `org-mode-line-clock-overrun'."
    286   :group 'org-clock
    287   :version "24.1"
    288   :type '(choice
    289 	  (const :tag "Just mark the time string" nil)
    290 	  (string :tag "Text to prepend")))
    291 
    292 (defcustom org-show-notification-timeout 3
    293   "Number of seconds to wait before closing Org notifications.
    294 This is applied to notifications sent with `notifications-notify'
    295 and `w32-notification-notify' only, not other mechanisms possibly
    296 set through `org-show-notification-handler'."
    297   :group 'org-clock
    298   :package-version '(Org . "9.4")
    299   :type 'integer)
    300 
    301 (defcustom org-show-notification-handler nil
    302   "Function or program to send notification with.
    303 The function or program will be called with the notification
    304 string as argument."
    305   :group 'org-clock
    306   :type '(choice
    307 	  (const nil)
    308 	  (string :tag "Program")
    309 	  (function :tag "Function")))
    310 
    311 (defgroup org-clocktable nil
    312   "Options concerning the clock table in Org mode."
    313   :tag "Org Clock Table"
    314   :group 'org-clock)
    315 
    316 (defcustom org-clocktable-defaults
    317   (list
    318    :maxlevel 2
    319    :lang (or (bound-and-true-p org-export-default-language) "en")
    320    :scope 'file
    321    :block nil
    322    :wstart 1
    323    :mstart 1
    324    :tstart nil
    325    :tend nil
    326    :step nil
    327    :stepskip0 nil
    328    :fileskip0 nil
    329    :tags nil
    330    :match nil
    331    :emphasize nil
    332    :link nil
    333    :narrow '40!
    334    :indent t
    335    :filetitle nil
    336    :hidefiles nil
    337    :formula nil
    338    :timestamp nil
    339    :level nil
    340    :tcolumns nil
    341    :formatter nil)
    342   "Default properties for clock tables."
    343   :group 'org-clock
    344   :package-version '(Org . "9.6")
    345   :type 'plist)
    346 
    347 (defcustom org-clock-clocktable-formatter 'org-clocktable-write-default
    348   "Function to turn clocking data into a table.
    349 For more information, see `org-clocktable-write-default'."
    350   :group 'org-clocktable
    351   :version "24.1"
    352   :type 'function)
    353 
    354 (defcustom org-clock-clocktable-language-setup
    355   '(("en" "File"     "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at")
    356     ("de" "Datei"    "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT" "Gesamtdauer" "Dateizeit" "Erstellt am")
    357     ("es" "Archivo"  "N" "Fecha y hora" "Tarea" "Duración" "TODO" "Duración total" "Tiempo archivo" "Generado el")
    358     ("fr" "Fichier"  "N" "Horodatage" "En-tête"  "Durée" "TOUT"  "Durée totale" "Durée fichier" "Horodatage sommaire à")
    359     ("nl" "Bestand"  "N" "Tijdstip" "Rubriek" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Klok overzicht op")
    360     ("nn" "Fil"      "N" "Tidspunkt" "Overskrift" "Tid" "ALLE" "Total tid" "Filtid" "Tidsoversyn")
    361     ("pl" "Plik"     "P" "Data i godzina" "Nagłówek" "Czas" "WSZYSTKO" "Czas całkowity" "Czas pliku" "Poddumowanie zegara na")
    362     ("pt-BR" "Arquivo" "N" "Data e hora" "Título" "Hora" "TODOS" "Hora total" "Hora do arquivo" "Resumo das horas em")
    363     ("sk" "Súbor"    "L" "Časová značka" "Záhlavie" "Čas" "VŠETKO" "Celkový čas" "Čas súboru" "Časový súhrn pre"))
    364   "Terms used in clocktable, translated to different languages."
    365   :group 'org-clocktable
    366   :version "24.1"
    367   :type 'alist)
    368 
    369 (defcustom org-clock-clocktable-default-properties '(:maxlevel 2)
    370   "Default properties for new clocktables.
    371 These will be inserted into the BEGIN line, to make it easy for users to
    372 play with them."
    373   :group 'org-clocktable
    374   :package-version '(Org . "9.2")
    375   :type 'plist)
    376 
    377 (defcustom org-clock-idle-time nil
    378   "When non-nil, resolve open clocks if the user is idle more than X minutes."
    379   :group 'org-clock
    380   :type '(choice
    381 	  (const :tag "Never" nil)
    382 	  (integer :tag "After N minutes")))
    383 
    384 (defcustom org-clock-auto-clock-resolution 'when-no-clock-is-running
    385   "When to automatically resolve open clocks found in Org buffers."
    386   :group 'org-clock
    387   :type '(choice
    388 	  (const :tag "Never" nil)
    389 	  (const :tag "Always" t)
    390 	  (const :tag "When no clock is running" when-no-clock-is-running)))
    391 
    392 (defcustom org-clock-report-include-clocking-task nil
    393   "When non-nil, include the current clocking task time in clock reports."
    394   :group 'org-clock
    395   :version "24.1"
    396   :type 'boolean)
    397 
    398 (defcustom org-clock-resolve-expert nil
    399   "Non-nil means do not show the splash buffer with the clock resolver."
    400   :group 'org-clock
    401   :version "24.1"
    402   :type 'boolean)
    403 
    404 (defcustom org-clock-continuously nil
    405   "Non-nil means to start clocking from the last clock-out time, if any."
    406   :type 'boolean
    407   :version "24.1"
    408   :group 'org-clock)
    409 
    410 (defcustom org-clock-total-time-cell-format "*%s*"
    411   "Format string for the total time cells."
    412   :group 'org-clock
    413   :version "24.1"
    414   :type 'string)
    415 
    416 (defcustom org-clock-file-time-cell-format "*%s*"
    417   "Format string for the file time cells."
    418   :group 'org-clock
    419   :version "24.1"
    420   :type 'string)
    421 
    422 (defcustom org-clock-clocked-in-display 'mode-line
    423   "Where to display clocked in task and accumulated time when clocked in.
    424 
    425 Allowed values are:
    426 
    427 both         displays in both mode line and frame title
    428 mode-line    displays only in mode line (default)
    429 frame-title  displays only in frame title
    430 nil          current clock is not displayed"
    431   :group 'org-clock
    432   :type '(choice
    433 	  (const :tag "Mode line" mode-line)
    434 	  (const :tag "Frame title" frame-title)
    435 	  (const :tag "Both" both)
    436 	  (const :tag "None" nil)))
    437 
    438 (defcustom org-clock-frame-title-format '(t org-mode-line-string)
    439   "The value for `frame-title-format' when clocking in.
    440 
    441 When `org-clock-clocked-in-display' is set to `frame-title'
    442 or `both', clocking in will replace `frame-title-format' with
    443 this value.  Clocking out will restore `frame-title-format'.
    444 
    445 This uses the same format as `frame-title-format', which see."
    446   :version "24.1"
    447   :group 'org-clock
    448   :type 'sexp)
    449 
    450 (defcustom org-clock-x11idle-program-name
    451   (if (executable-find "xprintidle")
    452       "xprintidle" "x11idle")
    453   "Name of the program which prints X11 idle time in milliseconds.
    454 
    455 you can do \"~$ sudo apt-get install xprintidle\" if you are using
    456 a Debian-based distribution.
    457 
    458 Alternatively, can find x11idle.c in
    459 https://orgmode.org/worg/code/scripts/x11idle.c"
    460   :group 'org-clock
    461   :package-version '(Org . "9.7")
    462   :type 'string)
    463 
    464 (defcustom org-clock-goto-before-context 2
    465   "Number of lines of context to display before currently clocked-in entry.
    466 This applies when using `org-clock-goto'."
    467   :group 'org-clock
    468   :type 'integer)
    469 
    470 (defcustom org-clock-display-default-range 'thisyear
    471   "Default range when displaying clocks with `org-clock-display'.
    472 Valid values are: `today', `yesterday', `thisweek', `lastweek',
    473 `thismonth', `lastmonth', `thisyear', `lastyear' and `untilnow'."
    474   :group 'org-clock
    475   :type '(choice (const today)
    476 		 (const yesterday)
    477 		 (const thisweek)
    478 		 (const lastweek)
    479 		 (const thismonth)
    480 		 (const lastmonth)
    481 		 (const thisyear)
    482 		 (const lastyear)
    483 		 (const untilnow)
    484 		 (const :tag "Select range interactively" interactive))
    485   :safe #'symbolp)
    486 
    487 (defcustom org-clock-auto-clockout-timer nil
    488   "Timer for auto clocking out when Emacs is idle.
    489 When set to a number, auto clock out the currently clocked in
    490 task after this number of seconds of idle time.
    491 
    492 This is only effective when `org-clock-auto-clockout-insinuate'
    493 is added to the user configuration."
    494   :group 'org-clock
    495   :package-version '(Org . "9.4")
    496   :type '(choice
    497 	  (integer :tag "Clock out after Emacs is idle for X seconds")
    498 	  (const :tag "Never auto clock out" nil)))
    499 
    500 (defcustom org-clock-ask-before-exiting t
    501   "If non-nil, ask if the user wants to clock out before exiting Emacs.
    502 This variable only has effect if set with \\[customize]."
    503   :set (lambda (symbol value)
    504          (if value
    505              (add-hook 'kill-emacs-query-functions #'org-clock-kill-emacs-query)
    506            (remove-hook 'kill-emacs-query-functions #'org-clock-kill-emacs-query))
    507          (set-default-toplevel-value symbol value))
    508   :type 'boolean
    509   :package-version '(Org . "9.5"))
    510 
    511 (defvar org-clock-in-prepare-hook nil
    512   "Hook run when preparing the clock.
    513 This hook is run before anything happens to the task that
    514 you want to clock in.  For example, you can use this hook
    515 to add an effort property.")
    516 (defvar org-clock-in-hook nil
    517   "Hook run when starting the clock.")
    518 (defvar org-clock-out-hook nil
    519   "Hook run when stopping the current clock.
    520 The point is at the current clock line when the hook is executed.
    521 
    522 The hook functions can access `org-clock-out-removed-last-clock' to
    523 check whether the latest CLOCK line has been cleared.")
    524 
    525 (defvar org-clock-cancel-hook nil
    526   "Hook run when canceling the current clock.")
    527 (defvar org-clock-goto-hook nil
    528   "Hook run when selecting the currently clocked-in entry.")
    529 (defvar org-clock-has-been-used nil
    530   "Has the clock been used during the current Emacs session?")
    531 
    532 (defvar org-clock-stored-history nil
    533   "Clock history, populated by `org-clock-load'.")
    534 (defvar org-clock-stored-resume-clock nil
    535   "Clock to resume, saved by `org-clock-load'.")
    536 
    537 ;;; The clock for measuring work time.
    538 
    539 (defvar org-mode-line-string "")
    540 (put 'org-mode-line-string 'risky-local-variable t)
    541 
    542 (defvar org-clock-mode-line-timer nil)
    543 (defvar org-clock-idle-timer nil)
    544 (defvar org-clock-heading) ; defined in org.el
    545 (defvar org-clock-start-time "")
    546 
    547 (defvar org-clock-leftover-time nil
    548   "If non-nil, user canceled a clock; this is when leftover time started.")
    549 
    550 (defvar org-clock-effort ""
    551   "Effort estimate of the currently clocking task.")
    552 
    553 (defvar org-clock-total-time nil
    554   "Holds total time, spent previously on currently clocked item.
    555 This does not include the time in the currently running clock.")
    556 
    557 (defvar org-clock-history nil
    558   "List of marker pointing to recent clocked tasks.")
    559 
    560 (defvar org-clock-default-task (make-marker)
    561   "Marker pointing to the default task that should clock time.
    562 The clock can be made to switch to this task after clocking out
    563 of a different task.")
    564 
    565 (defvar org-clock-interrupted-task (make-marker)
    566   "Marker pointing to the task that has been interrupted by the current clock.")
    567 
    568 (defvar org-clock-mode-line-map (make-sparse-keymap))
    569 (define-key org-clock-mode-line-map [mode-line mouse-2] #'org-clock-goto)
    570 (define-key org-clock-mode-line-map [mode-line mouse-1] #'org-clock-menu)
    571 
    572 (defun org-clock--translate (s language)
    573   "Translate string S into using string LANGUAGE.
    574 Assume S in the English term to translate.  Return S as-is if it
    575 cannot be translated."
    576   (or (nth (pcase s
    577              ;; "L" stands for "Level"
    578              ;; "ALL" stands for a line summarizing clock data across
    579              ;; all the files, when the clocktable includes multiple
    580              ;; files.
    581 	     ("File" 1) ("L" 2) ("Timestamp" 3) ("Headline" 4) ("Time" 5)
    582 	     ("ALL" 6) ("Total time" 7) ("File time" 8) ("Clock summary at" 9))
    583 	   (assoc-string language org-clock-clocktable-language-setup t))
    584       s))
    585 
    586 (defun org-clock--mode-line-heading ()
    587   "Return currently clocked heading, formatted for mode line."
    588   (cond ((functionp org-clock-heading-function)
    589 	 (funcall org-clock-heading-function))
    590 	((org-before-first-heading-p) "???")
    591 	(t (org-link-display-format
    592 	    (org-no-properties (org-get-heading t t t t))))))
    593 
    594 (defun org-clock-menu ()
    595   "Pop up org-clock menu."
    596   (interactive)
    597   (popup-menu
    598    '("Clock"
    599      ["Clock out" org-clock-out t]
    600      ["Change effort estimate" org-clock-modify-effort-estimate t]
    601      ["Go to clock entry" org-clock-goto t]
    602      ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"])))
    603 
    604 (defun org-clock-history-push (&optional pos buffer)
    605   "Push point marker to the clock history.
    606 When POS is provided, use it as marker point.
    607 When BUFFER and POS are provided, use marker at POS in base buffer of
    608 BUFFER."
    609   ;; When buffer is provided, POS must be provided.
    610   (cl-assert (or (not buffer) pos))
    611   (setq org-clock-history-length (max 1 org-clock-history-length))
    612   (let ((m (move-marker (make-marker)
    613 			(or pos (point)) (org-base-buffer
    614 					  (or buffer (current-buffer)))))
    615 	n l)
    616     (while (setq n (member m org-clock-history))
    617       (move-marker (car n) nil))
    618     (setq org-clock-history
    619 	  (delq nil
    620 		(mapcar (lambda (x) (if (marker-buffer x) x nil))
    621 			org-clock-history)))
    622     (when (>= (setq l (length org-clock-history)) org-clock-history-length)
    623       (setq org-clock-history
    624 	    (nreverse
    625 	     (nthcdr (- l org-clock-history-length -1)
    626 		     (nreverse org-clock-history)))))
    627     (push m org-clock-history)))
    628 
    629 (defun org-clock-save-markers-for-cut-and-paste (beg end)
    630   "Save relative positions of markers in region BEG..END.
    631 Save `org-clock-marker', `org-clock-hd-marker',
    632 `org-clock-default-task', `org-clock-interrupted-task', and the
    633 markers in `org-clock-history'."
    634   (org-check-and-save-marker org-clock-marker beg end)
    635   (org-check-and-save-marker org-clock-hd-marker beg end)
    636   (org-check-and-save-marker org-clock-default-task beg end)
    637   (org-check-and-save-marker org-clock-interrupted-task beg end)
    638   (dolist (m org-clock-history)
    639     (org-check-and-save-marker m beg end)))
    640 
    641 (defun org-clock-drawer-name ()
    642   "Return clock drawer's name for current entry, or nil."
    643   (let ((drawer (org-clock-into-drawer)))
    644     (cond ((integerp drawer)
    645 	   (let ((log-drawer (org-log-into-drawer)))
    646 	     (if (stringp log-drawer) log-drawer "LOGBOOK")))
    647 	  ((stringp drawer) drawer)
    648 	  (t nil))))
    649 
    650 (defun org-clocking-p ()
    651   "Return t when clocking a task."
    652   (not (equal (org-clocking-buffer) nil)))
    653 
    654 (defvar org-clock-before-select-task-hook nil
    655   "Hook called in task selection just before prompting the user.")
    656 
    657 (defun org-clock-select-task (&optional prompt)
    658   "Select a task that was recently associated with clocking.
    659 PROMPT is the prompt text to be used, as a string.
    660 Return marker position of the selected task.  Raise an error if
    661 there is no recent clock to choose from."
    662   (let (och chl sel-list rpl (i 0) s)
    663     ;; Remove successive dups from the clock history to consider
    664     (dolist (c org-clock-history)
    665       (unless (equal c (car och)) (push c och)))
    666     (setq och (reverse och) chl (length och))
    667     (if (zerop chl)
    668 	(user-error "No recent clock")
    669       (save-window-excursion
    670 	(switch-to-buffer-other-window
    671 	 (get-buffer-create "*Clock Task Select*"))
    672 	(erase-buffer)
    673 	(when (marker-buffer org-clock-default-task)
    674 	  (insert (org-add-props "Default Task\n" nil 'face 'bold))
    675 	  (setq s (org-clock-insert-selection-line ?d org-clock-default-task))
    676 	  (push s sel-list))
    677 	(when (marker-buffer org-clock-interrupted-task)
    678 	  (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold))
    679 	  (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task))
    680 	  (push s sel-list))
    681 	(when (org-clocking-p)
    682 	  (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold))
    683 	  (setq s (org-clock-insert-selection-line ?c org-clock-marker))
    684 	  (push s sel-list))
    685 	(insert (org-add-props "Recent Tasks\n" nil 'face 'bold))
    686 	(dolist (m och)
    687 	  (when (marker-buffer m)
    688 	    (setq i (1+ i)
    689 		  s (org-clock-insert-selection-line
    690 		     (if (< i 10)
    691 			 (+ i ?0)
    692 		       (+ i (- ?A 10))) m))
    693 	    (push s sel-list)))
    694 	(run-hooks 'org-clock-before-select-task-hook)
    695 	(goto-char (point-min))
    696 	;; Set min-height relatively to circumvent a possible but in
    697 	;; `fit-window-to-buffer'
    698 	(fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl)))
    699 	(message (or prompt "Select task for clocking:"))
    700 	(unwind-protect (setq cursor-type nil rpl (read-char-exclusive))
    701           (when-let* ((window (get-buffer-window "*Clock Task Select*" t)))
    702             (quit-window 'kill window))
    703 	  (when (get-buffer "*Clock Task Select*")
    704             (kill-buffer "*Clock Task Select*")))
    705 	(cond
    706 	 ((eq rpl ?q) nil)
    707 	 ((eq rpl ?x) nil)
    708 	 ((assoc rpl sel-list) (cdr (assoc rpl sel-list)))
    709 	 (t (user-error "Invalid task choice %c" rpl)))))))
    710 
    711 (defun org-clock-insert-selection-line (i marker)
    712   "Insert a line for the clock selection menu.
    713 And return a cons cell with the selection character integer and the marker
    714 pointing to it."
    715   (when (marker-buffer marker)
    716     (let (cat task heading prefix)
    717       (with-current-buffer (org-base-buffer (marker-buffer marker))
    718 	(org-with-wide-buffer
    719 	 (ignore-errors
    720 	   (goto-char marker)
    721 	   (setq cat (org-get-category)
    722 		 heading (org-get-heading 'notags)
    723 		 prefix (save-excursion
    724 			  (org-back-to-heading t)
    725 			  (looking-at org-outline-regexp)
    726 			  (match-string 0))
    727 		 task (substring
    728 		       (org-fontify-like-in-org-mode
    729 			(concat prefix heading)
    730 			org-odd-levels-only)
    731 		       (length prefix))))))
    732       (when (and cat task)
    733         (if (string-match-p "[[:print:]]" (make-string 1 i))
    734 	    (insert (format "[%c] %-12s  %s\n" i cat task))
    735           ;; Avoid non-printable characters.
    736           (insert (format "[N/A] %-12s  %s\n" cat task)))
    737 	(cons i marker)))))
    738 
    739 (defvar org-clock-task-overrun nil
    740   "Internal flag indicating if the clock has overrun the planned time.")
    741 (defvar org-clock-update-period 60
    742   "Number of seconds between mode line clock string updates.")
    743 
    744 (defun org-clock-get-clock-string ()
    745   "Form a clock-string, that will be shown in the mode line.
    746 If an effort estimate was defined for the current item, use
    747 01:30/01:50 format (clocked/estimated).
    748 If not, show simply the clocked time like 01:50."
    749   (let ((clocked-time (org-clock-get-clocked-time)))
    750     (if org-clock-effort
    751 	(let* ((effort-in-minutes (org-duration-to-minutes org-clock-effort))
    752 	       (work-done-str
    753 		(propertize (org-duration-from-minutes clocked-time)
    754 			    'face
    755 			    (if (and org-clock-task-overrun
    756 				     (not org-clock-task-overrun-text))
    757 				'org-mode-line-clock-overrun
    758 			      'org-mode-line-clock)))
    759 	       (effort-str (org-duration-from-minutes effort-in-minutes)))
    760 	  (format (propertize "[%s/%s] (%s) " 'face 'org-mode-line-clock)
    761 		  work-done-str effort-str org-clock-heading))
    762       (format (propertize "[%s] (%s) " 'face 'org-mode-line-clock)
    763 	      (org-duration-from-minutes clocked-time)
    764 	      org-clock-heading))))
    765 
    766 (defun org-clock-get-last-clock-out-time ()
    767   "Get the last clock-out time for the current subtree."
    768   (save-excursion
    769     (let ((end (save-excursion (org-end-of-subtree))))
    770       (when (re-search-forward (concat org-clock-string
    771 				       ".*\\]--\\(\\[[^]]+\\]\\)")
    772 			       end t)
    773 	(org-time-string-to-time (match-string 1))))))
    774 
    775 (defun org-clock-update-mode-line (&optional refresh)
    776   "Update mode line with clock information.
    777 When optional argument is non-nil, refresh cached heading."
    778   (if org-clock-effort
    779       (org-clock-notify-once-if-expired)
    780     (setq org-clock-task-overrun nil))
    781   (when refresh (setq org-clock-heading (org-clock--mode-line-heading)))
    782   (setq org-mode-line-string
    783 	(propertize
    784 	 (let ((clock-string (org-clock-get-clock-string))
    785 	       (help-text "Org mode clock is running.\nmouse-1 shows a \
    786 menu\nmouse-2 will jump to task"))
    787 	   (if (and (> org-clock-string-limit 0)
    788 		    (> (length clock-string) org-clock-string-limit))
    789 	       (propertize
    790 		(substring clock-string 0 org-clock-string-limit)
    791 		'help-echo (concat help-text ": " org-clock-heading))
    792 	     (propertize clock-string 'help-echo help-text)))
    793 	 'local-map org-clock-mode-line-map
    794 	 'mouse-face 'mode-line-highlight))
    795   (if (and org-clock-task-overrun org-clock-task-overrun-text)
    796       (setq org-mode-line-string
    797 	    (concat (propertize
    798 		     org-clock-task-overrun-text
    799 		     'face 'org-mode-line-clock-overrun)
    800 		    org-mode-line-string)))
    801   (force-mode-line-update))
    802 
    803 (defun org-clock-get-clocked-time ()
    804   "Get the clocked time for the current item in minutes.
    805 The time returned includes the time spent on this task in
    806 previous clocking intervals."
    807   (let ((currently-clocked-time
    808 	 (floor (org-time-convert-to-integer
    809 		 (time-since org-clock-start-time))
    810 		60)))
    811     (+ currently-clocked-time (or org-clock-total-time 0))))
    812 
    813 ;;;###autoload
    814 (defun org-clock-modify-effort-estimate (&optional value)
    815   "Add to or set the effort estimate of the item currently being clocked.
    816 VALUE can be a number of minutes, or a string with format hh:mm or mm.
    817 When the string starts with a + or a - sign, the current value of the effort
    818 property will be changed by that amount.  If the effort value is expressed
    819 as an unit defined in `org-duration-units' (e.g. \"3h\"), the modified
    820 value will be converted to a hh:mm duration.
    821 
    822 This command will update the \"Effort\" property of the currently
    823 clocked item, and the value displayed in the mode line."
    824   (interactive)
    825   (if (org-clock-is-active)
    826       (let ((current org-clock-effort) sign)
    827 	(unless value
    828 	  ;; Prompt user for a value or a change
    829 	  (setq value
    830 		(read-string
    831 		 (format "Set effort (hh:mm or mm%s): "
    832 			 (if current
    833 			     (format ", prefix + to add to %s" org-clock-effort)
    834 			   "")))))
    835 	(when (stringp value)
    836 	  ;; A string.  See if it is a delta
    837 	  (setq sign (string-to-char value))
    838 	  (if (member sign '(?- ?+))
    839 	      (setq current (org-duration-to-minutes current)
    840 		    value (substring value 1))
    841 	    (setq current 0))
    842 	  (setq value (org-duration-to-minutes value))
    843 	  (if (equal ?- sign)
    844 	      (setq value (- current value))
    845 	    (if (equal ?+ sign) (setq value (+ current value)))))
    846 	(setq value (max 0 value)
    847 	      org-clock-effort (org-duration-from-minutes value))
    848 	(org-entry-put org-clock-marker "Effort" org-clock-effort)
    849 	(org-clock-update-mode-line)
    850 	(message "Effort is now %s" org-clock-effort))
    851     (message "Clock is not currently active")))
    852 
    853 (defvar org-clock-notification-was-shown nil
    854   "Shows if we have shown notification already.")
    855 
    856 (defun org-clock-notify-once-if-expired ()
    857   "Show notification if we spent more time than we estimated before.
    858 Notification is shown only once."
    859   (when (org-clocking-p)
    860     (let ((effort-in-minutes (org-duration-to-minutes org-clock-effort))
    861 	  (clocked-time (org-clock-get-clocked-time)))
    862       (if (setq org-clock-task-overrun
    863 		(if (or (null effort-in-minutes) (zerop effort-in-minutes))
    864 		    nil
    865 		  (>= clocked-time effort-in-minutes)))
    866 	  (unless org-clock-notification-was-shown
    867 	    (setq org-clock-notification-was-shown t)
    868 	    (org-notify
    869 	     (format-message "Task `%s' should be finished by now. (%s)"
    870                              org-clock-heading org-clock-effort)
    871              org-clock-sound))
    872 	(setq org-clock-notification-was-shown nil)))))
    873 
    874 (defun org-notify (notification &optional play-sound)
    875   "Send a NOTIFICATION and maybe PLAY-SOUND.
    876 If PLAY-SOUND is non-nil, it overrides `org-clock-sound'."
    877   (org-show-notification notification)
    878   (if play-sound (org-clock-play-sound play-sound)))
    879 
    880 (defun org-show-notification (notification)
    881   "Show notification.
    882 Use `org-show-notification-handler' if defined,
    883 use libnotify if available, or fall back on a message."
    884   (ignore-errors (require 'notifications))
    885   (cond ((functionp org-show-notification-handler)
    886 	 (funcall org-show-notification-handler notification))
    887 	((stringp org-show-notification-handler)
    888 	 (start-process "emacs-timer-notification" nil
    889 			org-show-notification-handler notification))
    890         ((fboundp 'haiku-notifications-notify)
    891          ;; N.B. timeouts are not available under Haiku.
    892          (haiku-notifications-notify :title "Org mode message"
    893                                      :body notification
    894                                      :urgency 'low))
    895         ((fboundp 'android-notifications-notify)
    896          ;; N.B. timeouts are not available under Haiku or Android.
    897          (android-notifications-notify :title "Org mode message"
    898                                        :body notification
    899                                        ;; Low urgency notifications
    900                                        ;; are by default hidden.
    901                                        :urgency 'normal))
    902 	((fboundp 'w32-notification-notify)
    903 	 (let ((id (w32-notification-notify
    904 		    :title "Org mode message"
    905 		    :body notification
    906 		    :urgency 'low)))
    907 	   (run-with-timer
    908 	    org-show-notification-timeout
    909 	    nil
    910 	    (lambda () (w32-notification-close id)))))
    911         ((fboundp 'ns-do-applescript)
    912          (ns-do-applescript
    913           (format "display notification \"%s\" with title \"Org mode notification\""
    914                   (replace-regexp-in-string "\"" "#" notification))))
    915 	((fboundp 'notifications-notify)
    916 	 (notifications-notify
    917 	  :title "Org mode message"
    918 	  :body notification
    919 	  :timeout (* org-show-notification-timeout 1000)
    920 	  ;; FIXME how to link to the Org icon?
    921 	  ;; :app-icon "~/.emacs.d/icons/mail.png"
    922 	  :urgency 'low))
    923 	((executable-find "notify-send")
    924 	 (start-process "emacs-timer-notification" nil
    925 			"notify-send" notification))
    926 	;; Maybe the handler will send a message, so only use message as
    927 	;; a fall back option
    928 	(t (message "%s" notification))))
    929 
    930 (defun org-clock-play-sound (&optional clock-sound)
    931   "Play sound as configured by `org-clock-sound'.
    932 Use alsa's aplay tool if available.
    933 If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
    934   (let ((org-clock-sound (or clock-sound org-clock-sound)))
    935     (cond
    936      ((not org-clock-sound))
    937      ((eq org-clock-sound t) (beep t) (beep t))
    938      ((stringp org-clock-sound)
    939       (let ((file (expand-file-name org-clock-sound)))
    940 	(if (file-exists-p file)
    941 	    (if (executable-find "aplay")
    942 		(start-process "org-clock-play-notification" nil
    943 			       "aplay" file)
    944 	      (condition-case-unless-debug nil
    945 		  (play-sound-file file)
    946 		(error (beep t) (beep t))))))))))
    947 
    948 (defvar org-clock-mode-line-entry nil
    949   "Information for the mode line about the running clock.")
    950 
    951 (defun org-find-open-clocks (file)
    952   "Search through the given file and find all open clocks."
    953   (let ((buf (or (get-file-buffer file)
    954 		 (find-file-noselect file)))
    955 	(org-clock-re (concat org-clock-string " \\(\\[.*?\\]\\)$"))
    956 	clocks)
    957     (with-current-buffer buf
    958       (save-excursion
    959 	(goto-char (point-min))
    960 	(while (re-search-forward org-clock-re nil t)
    961           (when (save-match-data
    962                   (org-element-type-p (org-element-at-point) 'clock))
    963 	    (push (cons (copy-marker (match-end 1) t)
    964 		        (org-time-string-to-time (match-string 1)))
    965 		  clocks)))))
    966     clocks))
    967 
    968 (defsubst org-is-active-clock (clock)
    969   "Return t if CLOCK is the currently active clock."
    970   (and (org-clock-is-active)
    971        (= org-clock-marker (car clock))))
    972 
    973 (defmacro org-with-clock-position (clock &rest forms)
    974   "Evaluate FORMS with CLOCK as the current active clock."
    975   (declare (indent 1) (debug t))
    976   `(with-current-buffer (marker-buffer (car ,clock))
    977      (org-with-wide-buffer
    978       (goto-char (car ,clock))
    979       (forward-line 0)
    980       ,@forms)))
    981 
    982 (defmacro org-with-clock (clock &rest forms)
    983   "Evaluate FORMS with CLOCK as the current active clock.
    984 This macro also protects the current active clock from being altered."
    985   (declare (indent 1) (debug t))
    986   `(org-with-clock-position ,clock
    987      (let ((org-clock-start-time (cdr ,clock))
    988 	   (org-clock-total-time)
    989 	   (org-clock-history)
    990 	   (org-clock-effort)
    991 	   (org-clock-marker (car ,clock))
    992 	   (org-clock-hd-marker (save-excursion
    993 				  (org-back-to-heading t)
    994 				  (point-marker))))
    995        ,@forms)))
    996 
    997 (defsubst org-clock-clock-in (clock &optional resume start-time)
    998   "Clock in to the clock located by CLOCK.
    999 If necessary, clock-out of the currently active clock."
   1000   (org-with-clock-position clock
   1001     (let ((org-clock-in-resume (or resume org-clock-in-resume)))
   1002       (org-clock-in nil start-time))))
   1003 
   1004 (defsubst org-clock-clock-out (clock &optional fail-quietly at-time)
   1005   "Clock out of the clock located by CLOCK."
   1006   (let ((temp (copy-marker (car clock)
   1007 			   (marker-insertion-type (car clock)))))
   1008     (if (org-is-active-clock clock)
   1009 	(org-clock-out nil fail-quietly at-time)
   1010       (org-with-clock clock
   1011 	(org-clock-out nil fail-quietly at-time)))
   1012     (setcar clock temp)))
   1013 
   1014 (defsubst org-clock-clock-cancel (clock)
   1015   "Cancel the clock located by CLOCK."
   1016   (let ((temp (copy-marker (car clock)
   1017 			   (marker-insertion-type (car clock)))))
   1018     (if (org-is-active-clock clock)
   1019 	(org-clock-cancel)
   1020       (org-with-clock clock
   1021 	(org-clock-cancel)))
   1022     (setcar clock temp)))
   1023 
   1024 (defvar org-clock-clocking-in nil)
   1025 (defvar org-clock-resolving-clocks nil)
   1026 (defvar org-clock-resolving-clocks-due-to-idleness nil)
   1027 
   1028 (defun org-clock-resolve-clock
   1029     (clock resolve-to clock-out-time close restart fail-quietly)
   1030   "Resolve CLOCK given the time RESOLVE-TO, and the present.
   1031 CLOCK is a cons cell of the form (MARKER START-TIME)."
   1032   (let ((org-clock-resolving-clocks t)
   1033 	;; If the clocked entry contained only a clock and possibly
   1034 	;; the associated drawer, and we either cancel it or clock it
   1035 	;; out, `org-clock-out-remove-zero-time-clocks' may clear all
   1036 	;; contents, and leave point on the /next/ headline.  We store
   1037 	;; the current entry location to be able to get back here when
   1038 	;; we need to clock in again the previously clocked task.
   1039 	(heading (org-with-point-at (car clock)
   1040 		   (org-back-to-heading t)
   1041 		   (point-marker))))
   1042     (pcase resolve-to
   1043       (`nil
   1044        (org-clock-clock-cancel clock)
   1045        (when (and restart (not org-clock-clocking-in))
   1046 	 (org-with-point-at heading (org-clock-in))))
   1047       (`now
   1048        (cond
   1049 	(restart (error "RESTART is not valid here"))
   1050 	((or close org-clock-clocking-in)
   1051 	 (org-clock-clock-out clock fail-quietly))
   1052 	((org-is-active-clock clock) nil)
   1053 	(t (org-clock-clock-in clock t))))
   1054       ((pred (time-less-p nil))
   1055        (error "RESOLVE-TO must refer to a time in the past"))
   1056       (_
   1057        (when restart (error "RESTART is not valid here"))
   1058        (org-clock-clock-out clock fail-quietly (or clock-out-time resolve-to))
   1059        (cond
   1060 	(org-clock-clocking-in nil)
   1061 	(close
   1062 	 (setq org-clock-leftover-time (and (null clock-out-time) resolve-to)))
   1063 	(t
   1064 	 (org-with-point-at heading
   1065 	   (org-clock-in nil (and clock-out-time resolve-to)))))))))
   1066 
   1067 (defun org-clock-jump-to-current-clock (&optional effective-clock)
   1068   "When an Org clock is running, jump to it."
   1069   (let ((drawer (org-clock-into-drawer))
   1070 	(clock (or effective-clock (cons org-clock-marker
   1071 					 org-clock-start-time))))
   1072     (unless (marker-buffer (car clock))
   1073       (user-error "No Org clock is currently running"))
   1074     (org-with-clock clock (org-clock-goto))
   1075     (with-current-buffer (marker-buffer (car clock))
   1076       (goto-char (car clock))
   1077       (when drawer
   1078 	(org-with-wide-buffer
   1079 	 (let ((drawer-re (format "^[ \t]*:%s:[ \t]*$"
   1080 				  (regexp-quote (if (stringp drawer) drawer "LOGBOOK"))))
   1081 	       (beg (save-excursion (org-back-to-heading t) (point))))
   1082 	   (catch 'exit
   1083 	     (while (re-search-backward drawer-re beg t)
   1084 	       (let ((element (org-element-at-point)))
   1085 		 (when (org-element-type-p element 'drawer)
   1086 		   (when (> (org-element-end element) (car clock))
   1087 		     (org-fold-hide-drawer-toggle 'off nil element))
   1088 		   (throw 'exit nil)))))))))))
   1089 
   1090 (defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
   1091   "Resolve an open Org clock.
   1092 An open clock was found, with `dangling' possibly being non-nil.
   1093 If this function was invoked with a prefix argument, non-dangling
   1094 open clocks are ignored.  The given clock requires some sort of
   1095 user intervention to resolve it, either because a clock was left
   1096 dangling or due to an idle timeout.  The clock resolution can
   1097 either be:
   1098 
   1099   (a) deleted, the user doesn't care about the clock
   1100   (b) restarted from the current time (if no other clock is open)
   1101   (c) closed, giving the clock X minutes
   1102   (d) closed and then restarted
   1103   (e) resumed, as if the user had never left
   1104 
   1105 The format of clock is (CONS MARKER START-TIME), where MARKER
   1106 identifies the buffer and position the clock is open at (and
   1107 thus, the heading it's under), and START-TIME is when the clock
   1108 was started."
   1109   (cl-assert clock)
   1110   (let* ((ch
   1111 	  (save-window-excursion
   1112 	    (save-excursion
   1113 	      (unless org-clock-resolving-clocks-due-to-idleness
   1114 		(org-clock-jump-to-current-clock clock))
   1115 	      (unless org-clock-resolve-expert
   1116 		(with-output-to-temp-buffer "*Org Clock*"
   1117 		  (princ (format-message "Select a Clock Resolution Command:
   1118 
   1119 i/q      Ignore this question; the same as keeping all the idle time.
   1120 
   1121 k/K      Keep X minutes of the idle time (default is all).  If this
   1122          amount is less than the default, you will be clocked out
   1123          that many minutes after the time that idling began, and then
   1124          clocked back in at the present time.
   1125 
   1126 t/T      Like `k', but will ask you to specify a time (when you got
   1127          distracted away), instead of a number of minutes.
   1128 
   1129 g/G      Indicate that you \"got back\" X minutes ago.  This is quite
   1130          different from `k': it clocks you out from the beginning of
   1131          the idle period and clock you back in X minutes ago.
   1132 
   1133 s/S      Subtract the idle time from the current clock.  This is the
   1134          same as keeping 0 minutes.
   1135 
   1136 C        Cancel the open timer altogether.  It will be as though you
   1137          never clocked in.
   1138 
   1139 j/J      Jump to the current clock, to make manual adjustments.
   1140 
   1141 For all these options, using uppercase makes your final state
   1142 to be CLOCKED OUT."))))
   1143 	      (org-fit-window-to-buffer (get-buffer-window "*Org Clock*"))
   1144 	      (let (char-pressed)
   1145 		(while (or (null char-pressed)
   1146 			   (and (not (memq char-pressed
   1147 					   '(?k ?K ?g ?G ?s ?S ?C
   1148 						?j ?J ?i ?q ?t ?T)))
   1149 				(or (ding) t)))
   1150 		  (setq char-pressed
   1151 			(read-char-exclusive (concat (funcall prompt-fn clock)
   1152 					             " [jkKtTgGSscCiq]? ")
   1153 				             nil 45)))
   1154 		(and (not (memq char-pressed '(?i ?q))) char-pressed)))))
   1155 	 (default
   1156 	   (floor (org-time-convert-to-integer (time-since last-valid))
   1157 		  60))
   1158 	 (keep
   1159 	  (or (and (memq ch '(?k ?K))
   1160 		   (read-number "Keep how many minutes: " default))
   1161 	      (and (memq ch '(?t ?T))
   1162 		   (floor
   1163 		    (/ (float-time
   1164 			(time-subtract (org-read-date t t) last-valid))
   1165 		       60)))))
   1166 	 (gotback
   1167 	  (and (memq ch '(?g ?G))
   1168 	       (read-number "Got back how many minutes ago: " default)))
   1169 	 (subtractp (memq ch '(?s ?S)))
   1170 	 (barely-started-p (time-less-p
   1171 			    (time-subtract last-valid (cdr clock))
   1172 			    45))
   1173 	 (start-over (and subtractp barely-started-p)))
   1174     (cond
   1175      ((memq ch '(?j ?J))
   1176       (if (eq ch ?J)
   1177 	  (org-clock-resolve-clock clock 'now nil t nil fail-quietly))
   1178       (org-clock-jump-to-current-clock clock))
   1179      ((or (null ch)
   1180 	  (not (memq ch '(?k ?K ?g ?G ?s ?S ?C ?t ?T))))
   1181       (message ""))
   1182      (t
   1183       (org-clock-resolve-clock
   1184        clock (cond
   1185 	      ((or (eq ch ?C)
   1186 		   ;; If the time on the clock was less than a minute before
   1187 		   ;; the user went away, and they've ask to subtract all the
   1188 		   ;; time...
   1189 		   start-over)
   1190 	       nil)
   1191 	      ((or subtractp
   1192 		   (and gotback (= gotback 0)))
   1193 	       last-valid)
   1194 	      ((or (and keep (= keep default))
   1195 		   (and gotback (= gotback default)))
   1196 	       'now)
   1197 	      (keep
   1198 	       (time-add last-valid (* 60 keep)))
   1199 	      (gotback
   1200 	       (time-since (* 60 gotback)))
   1201 	      (t
   1202 	       (error "Unexpected, please report this as a bug")))
   1203        (and gotback last-valid)
   1204        (memq ch '(?K ?G ?S ?T))
   1205        (and start-over
   1206 	    (not (memq ch '(?K ?G ?S ?C))))
   1207        fail-quietly)))))
   1208 
   1209 ;;;###autoload
   1210 (defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid)
   1211   "Resolve all currently open Org clocks.
   1212 If `only-dangling-p' is non-nil, only ask to resolve dangling
   1213 \(i.e., not currently open and valid) clocks."
   1214   (interactive "P")
   1215   (unless org-clock-resolving-clocks
   1216     (let ((org-clock-resolving-clocks t))
   1217       (dolist (file (org-files-list))
   1218 	(let ((clocks (org-find-open-clocks file)))
   1219 	  (dolist (clock clocks)
   1220 	    (let ((dangling (or (not (org-clock-is-active))
   1221 				(/= (car clock) org-clock-marker))))
   1222 	      (if (or (not only-dangling-p) dangling)
   1223 		  (org-clock-resolve
   1224 		   clock
   1225 		   (or prompt-fn
   1226 		       (lambda (clock)
   1227 			 (format
   1228 			  "Dangling clock started %d mins ago"
   1229 			  (floor (org-time-convert-to-integer
   1230 				  (time-since (cdr clock)))
   1231 				 60))))
   1232 		   (or last-valid
   1233 		       (cdr clock)))))))))))
   1234 
   1235 (defun org-emacs-idle-seconds ()
   1236   "Return the current Emacs idle time in seconds, or nil if not idle."
   1237   (let ((idle-time (current-idle-time)))
   1238     (if idle-time
   1239 	(float-time idle-time)
   1240       0)))
   1241 
   1242 (defun org-mac-idle-seconds ()
   1243   "Return the current Mac idle time in seconds."
   1244   (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'")))
   1245 
   1246 (defvar org-x11idle-exists-p
   1247   ;; Check that x11idle exists.  But don't do that on DOS/Windows,
   1248   ;; since the command definitely does NOT exist there, and invoking
   1249   ;; COMMAND.COM on MS-Windows is a bad idea -- it hangs.
   1250   (and (null (memq system-type '(windows-nt ms-dos)))
   1251        (eq 0 (call-process-shell-command
   1252               (format "command -v %s" org-clock-x11idle-program-name)))
   1253        ;; Check that x11idle can retrieve the idle time
   1254        ;; FIXME: Why "..-shell-command" rather than just `call-process'?
   1255        (eq 0 (call-process-shell-command org-clock-x11idle-program-name))))
   1256 
   1257 (defun org-x11-idle-seconds ()
   1258   "Return the current X11 idle time in seconds."
   1259   (/ (string-to-number (shell-command-to-string org-clock-x11idle-program-name)) 1000))
   1260 
   1261 (defvar org-logind-dbus-session-path
   1262   (when (and (boundp 'dbus-runtime-version)
   1263              (require 'dbus nil t)
   1264              (member "org.freedesktop.login1" (dbus-list-activatable-names)))
   1265     (ignore-errors
   1266       (dbus-call-method
   1267        :system "org.freedesktop.login1"
   1268        "/org/freedesktop/login1"
   1269        "org.freedesktop.login1.Manager"
   1270        "GetSessionByPID" (emacs-pid))))
   1271   "D-Bus session path for the elogind interface.")
   1272 
   1273 (defun org-logind-user-idle-seconds ()
   1274   "Return the number of idle seconds for the user according to logind."
   1275   (- (float-time)
   1276      (/ (dbus-get-property
   1277          :system "org.freedesktop.login1"
   1278          org-logind-dbus-session-path
   1279          "org.freedesktop.login1.Session" "IdleSinceHint")
   1280         1e6)))
   1281 
   1282 (defun org-user-idle-seconds ()
   1283   "Return the number of seconds the user has been idle for.
   1284 This routine returns a floating point number."
   1285   (cond
   1286    ((eq system-type 'darwin)
   1287     (org-mac-idle-seconds))
   1288    ((and (eq window-system 'x) org-x11idle-exists-p)
   1289     (org-x11-idle-seconds))
   1290    ((and
   1291      org-logind-dbus-session-path
   1292      (dbus-get-property
   1293       :system "org.freedesktop.login1"
   1294       org-logind-dbus-session-path
   1295       "org.freedesktop.login1.Session" "IdleHint"))
   1296     (org-logind-user-idle-seconds))
   1297    (t
   1298     (org-emacs-idle-seconds))))
   1299 
   1300 (defvar org-clock-user-idle-seconds)
   1301 
   1302 (defun org-resolve-clocks-if-idle ()
   1303   "Resolve all currently open Org clocks.
   1304 This is performed after `org-clock-idle-time' minutes, to check
   1305 if the user really wants to stay clocked in after being idle for
   1306 so long."
   1307   (when (and org-clock-idle-time (not org-clock-resolving-clocks)
   1308 	     org-clock-marker (marker-buffer org-clock-marker))
   1309     (let* ((org-clock-user-idle-seconds (org-user-idle-seconds))
   1310 	   (org-clock-user-idle-start
   1311 	    (time-since org-clock-user-idle-seconds))
   1312 	   (org-clock-resolving-clocks-due-to-idleness t))
   1313       (when (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))
   1314           (cancel-timer org-clock-idle-timer)
   1315           (setq org-clock-idle-timer nil)
   1316 	  (org-clock-resolve
   1317 	   (cons org-clock-marker
   1318 		 org-clock-start-time)
   1319 	   (lambda (_)
   1320 	     (format "Clocked in & idle for %.1f mins"
   1321 		     (/ (float-time
   1322 			 (time-since org-clock-user-idle-start))
   1323 			60)))
   1324 	   org-clock-user-idle-start)
   1325           (when (and (org-clocking-p) (not org-clock-idle-timer))
   1326             (setq org-clock-idle-timer
   1327 	          (run-with-timer 60 60 #'org-resolve-clocks-if-idle)))))))
   1328 
   1329 (defvar org-clock-current-task nil "Task currently clocked in.")
   1330 (defvar org-clock-out-time nil) ; store the time of the last clock-out
   1331 (defvar org--msg-extra)
   1332 
   1333 ;;;###autoload
   1334 (defun org-clock-in (&optional select start-time)
   1335   "Start the clock on the current item.
   1336 
   1337 If necessary, clock-out of the currently active clock.
   1338 
   1339 With a `\\[universal-argument]' prefix argument SELECT, offer a list of \
   1340 recently clocked
   1341 tasks to clock into.
   1342 
   1343 When SELECT is `\\[universal-argument] \ \\[universal-argument]', \
   1344 clock into the current task and mark it as
   1345 the default task, a special task that will always be offered in the
   1346 clocking selection, associated with the letter `d'.
   1347 
   1348 When SELECT is `\\[universal-argument] \\[universal-argument] \
   1349 \\[universal-argument]', clock in by using the last clock-out
   1350 time as the start time.  See `org-clock-continuously' to make this
   1351 the default behavior."
   1352   (interactive "P")
   1353   (setq org-clock-notification-was-shown nil)
   1354   (catch 'abort
   1355     (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
   1356 			     (org-clocking-p)))
   1357 	  ts selected-task target-pos (org--msg-extra "")
   1358 	  (leftover (and (not org-clock-resolving-clocks)
   1359 			 org-clock-leftover-time)))
   1360 
   1361       (when (and org-clock-auto-clock-resolution
   1362 		 (or (not interrupting)
   1363 		     (eq t org-clock-auto-clock-resolution))
   1364 		 (not org-clock-clocking-in)
   1365 		 (not org-clock-resolving-clocks))
   1366 	(setq org-clock-leftover-time nil)
   1367 	(let ((org-clock-clocking-in t))
   1368 	  (org-resolve-clocks)))    ; check if any clocks are dangling
   1369 
   1370       (when (equal select '(64))
   1371 	;; Set start-time to `org-clock-out-time'
   1372 	(let ((org-clock-continuously t))
   1373 	  (org-clock-in nil org-clock-out-time)
   1374 	  (throw 'abort nil)))
   1375 
   1376       (when (equal select '(4))
   1377 	(pcase (org-clock-select-task "Clock-in on task: ")
   1378 	  (`nil (error "Abort"))
   1379 	  (task (setq selected-task (copy-marker task)))))
   1380 
   1381       (when (equal select '(16))
   1382 	;; Mark as default clocking task
   1383 	(org-clock-mark-default-task))
   1384 
   1385       (when interrupting
   1386 	;; We are interrupting the clocking of a different task.  Save
   1387 	;; a marker to this task, so that we can go back.  First check
   1388 	;; if we are trying to clock into the same task!
   1389 	(when (or selected-task (derived-mode-p 'org-mode))
   1390 	  (org-with-point-at selected-task
   1391 	    (unless selected-task (org-back-to-heading t))
   1392 	    (when (and (eq (marker-buffer org-clock-hd-marker)
   1393 			   (org-base-buffer (current-buffer)))
   1394 		       (= (point) (marker-position org-clock-hd-marker))
   1395 		       (equal org-clock-current-task (org-get-heading t t t t)))
   1396 	      (message "Clock continues in %S" org-clock-heading)
   1397 	      (throw 'abort nil))))
   1398 	(move-marker org-clock-interrupted-task
   1399 		     (marker-position org-clock-marker)
   1400 		     (marker-buffer org-clock-marker))
   1401 	(let ((org-clock-clocking-in t))
   1402 	  (org-clock-out nil t)))
   1403 
   1404       ;; Clock in at which position?
   1405       (setq target-pos
   1406 	    (if (and (eobp) (not (org-at-heading-p)))
   1407 		(org-with-wide-buffer (line-beginning-position 0))
   1408 	      (point)))
   1409       (save-excursion
   1410 	(when (and selected-task (marker-buffer selected-task))
   1411 	  ;; There is a selected task, move to the correct buffer
   1412 	  ;; and set the new target position.
   1413 	  (set-buffer (org-base-buffer (marker-buffer selected-task)))
   1414 	  (setq target-pos (marker-position selected-task))
   1415 	  (move-marker selected-task nil))
   1416 	(org-with-wide-buffer
   1417 	 (goto-char target-pos)
   1418 	 (org-back-to-heading t)
   1419 	 (or interrupting (move-marker org-clock-interrupted-task nil))
   1420 	 (run-hooks 'org-clock-in-prepare-hook)
   1421 	 (org-clock-history-push)
   1422 	 (setq org-clock-current-task (org-get-heading t t t t))
   1423 	 (cond ((functionp org-clock-in-switch-to-state)
   1424 		(let ((case-fold-search nil))
   1425 		  (looking-at org-complex-heading-regexp))
   1426 		(let ((newstate (funcall org-clock-in-switch-to-state
   1427 					 (match-string 2))))
   1428 		  (when newstate (org-todo newstate))))
   1429 	       ((and org-clock-in-switch-to-state
   1430 		     (not (looking-at (concat org-outline-regexp "[ \t]*"
   1431 					      org-clock-in-switch-to-state
   1432 					      "\\(?:[ \t]\\|$\\)"))))
   1433 		(org-todo org-clock-in-switch-to-state)))
   1434 	 (setq org-clock-heading (org-clock--mode-line-heading))
   1435 	 (org-clock-find-position org-clock-in-resume)
   1436 	 (cond
   1437 	  ((and org-clock-in-resume
   1438 		(looking-at
   1439 		 (concat "^[ \t]*" org-clock-string
   1440 			 " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
   1441 			 " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
   1442 	   (message "Matched %s" (match-string 1))
   1443 	   (setq ts (concat "[" (match-string 1) "]"))
   1444 	   (goto-char (match-end 1))
   1445 	   (setq org-clock-start-time
   1446 		 (org-time-string-to-time (match-string 1)))
   1447 	   (setq org-clock-effort (org-entry-get (point) org-effort-property))
   1448 	   (setq org-clock-total-time (org-clock-sum-current-item
   1449 				       (org-clock-get-sum-start))))
   1450 	  ((eq org-clock-in-resume 'auto-restart)
   1451 	   ;; called from org-clock-load during startup,
   1452 	   ;; do not interrupt, but warn!
   1453 	   (message "Cannot restart clock because task does not contain unfinished clock")
   1454 	   (ding)
   1455 	   (sit-for 2)
   1456 	   (throw 'abort nil))
   1457 	  (t
   1458            ;; Make sure that point moves after clock line upon
   1459            ;; inserting it.  Then, users can continue typing even if
   1460            ;; point was right where the clock is inserted.
   1461 	   (insert-before-markers-and-inherit "\n")
   1462 	   (backward-char 1)
   1463 	   (when (and (save-excursion
   1464 			(end-of-line 0)
   1465 			(org-in-item-p)))
   1466 	     (forward-line 0)
   1467 	     (indent-line-to (max 0 (- (current-indentation) 2))))
   1468 	   (insert-and-inherit org-clock-string " ")
   1469 	   (setq org-clock-effort (org-entry-get (point) org-effort-property))
   1470 	   (setq org-clock-total-time (org-clock-sum-current-item
   1471 				       (org-clock-get-sum-start)))
   1472 	   (setq org-clock-start-time
   1473 		 (or (and org-clock-continuously org-clock-out-time)
   1474 		     (and leftover
   1475 			  (y-or-n-p
   1476 			   (format
   1477 			    "You stopped another clock %d mins ago; start this one from then? "
   1478 			    (/ (org-time-convert-to-integer
   1479 				(time-subtract
   1480 				 (org-current-time org-clock-rounding-minutes t)
   1481 				 leftover))
   1482 			       60)))
   1483 			  leftover)
   1484 		     start-time
   1485 		     (org-current-time org-clock-rounding-minutes t)))
   1486 	   (setq ts (org-insert-timestamp org-clock-start-time
   1487 					  'with-hm 'inactive))
   1488 	   (org-indent-line)))
   1489 	 (move-marker org-clock-marker (point) (buffer-base-buffer))
   1490 	 (move-marker org-clock-hd-marker
   1491 		      (save-excursion (org-back-to-heading t) (point))
   1492 		      (buffer-base-buffer))
   1493 	 (setq org-clock-has-been-used t)
   1494 	 ;; add to mode line
   1495 	 (when (or (eq org-clock-clocked-in-display 'mode-line)
   1496 		   (eq org-clock-clocked-in-display 'both))
   1497 	   (or global-mode-string (setq global-mode-string '("")))
   1498 	   (or (memq 'org-mode-line-string global-mode-string)
   1499 	       (setq global-mode-string
   1500 		     (append global-mode-string '(org-mode-line-string)))))
   1501 	 ;; add to frame title
   1502 	 (when (or (eq org-clock-clocked-in-display 'frame-title)
   1503 		   (eq org-clock-clocked-in-display 'both))
   1504 	   (setq org-frame-title-format-backup frame-title-format)
   1505 	   (setq frame-title-format org-clock-frame-title-format))
   1506 	 (org-clock-update-mode-line)
   1507 	 (when org-clock-mode-line-timer
   1508 	   (cancel-timer org-clock-mode-line-timer)
   1509 	   (setq org-clock-mode-line-timer nil))
   1510 	 (when org-clock-clocked-in-display
   1511 	   (setq org-clock-mode-line-timer
   1512 		 (run-with-timer org-clock-update-period
   1513 				 org-clock-update-period
   1514 				 #'org-clock-update-mode-line)))
   1515 	 (when org-clock-idle-timer
   1516 	   (cancel-timer org-clock-idle-timer)
   1517 	   (setq org-clock-idle-timer nil))
   1518 	 (setq org-clock-idle-timer
   1519 	       (run-with-timer 60 60 #'org-resolve-clocks-if-idle))
   1520 	 (message "Clock starts at %s - %s" ts org--msg-extra)
   1521 	 (run-hooks 'org-clock-in-hook))))))
   1522 
   1523 (defvar org-clock--auto-clockout-timer-obj nil
   1524   "Timer object holding the existing clockout timer.")
   1525 (defun org-clock--auto-clockout-maybe ()
   1526   "Clock out the currently clocked in task when idle.
   1527 See `org-clock-auto-clockout-timer' to set the idle time span.
   1528 
   1529 This function is to be called by a timer."
   1530   (when (and (numberp org-clock-auto-clockout-timer)
   1531 	     org-clock-current-task)
   1532     (let ((user-idle-seconds (org-user-idle-seconds)))
   1533       (cond
   1534        ;; Already idle.  Clock out.
   1535        ((>= user-idle-seconds org-clock-auto-clockout-timer)
   1536         (setq org-clock--auto-clockout-timer-obj nil)
   1537         (org-clock-out))
   1538        ;; Emacs is idle but system is not.  Retry assuming that system will remain idle.
   1539        ((>= (org-emacs-idle-seconds) org-clock-auto-clockout-timer)
   1540         (setq org-clock--auto-clockout-timer-obj
   1541               (run-with-timer
   1542                (- org-clock-auto-clockout-timer user-idle-seconds)
   1543                nil #'org-clock--auto-clockout-maybe)))
   1544        ;; Emacs is not idle.  Check again next time we are idle.
   1545        (t
   1546         (setq org-clock--auto-clockout-timer-obj
   1547               (run-with-idle-timer
   1548                org-clock-auto-clockout-timer nil #'org-clock--auto-clockout-maybe)))))))
   1549 
   1550 (defun org-clock-auto-clockout ()
   1551   "Clock out the currently clocked in task if Emacs is idle.
   1552 See `org-clock-auto-clockout-timer' to set the idle time span.
   1553 
   1554 This is only effective when `org-clock-auto-clockout-insinuate'
   1555 is present in the user configuration."
   1556   (when (and (numberp org-clock-auto-clockout-timer)
   1557 	     org-clock-current-task
   1558              (not (timerp org-clock--auto-clockout-timer-obj)))
   1559     (setq org-clock--auto-clockout-timer-obj
   1560           (run-with-idle-timer
   1561            org-clock-auto-clockout-timer nil #'org-clock--auto-clockout-maybe))))
   1562 
   1563 ;;;###autoload
   1564 (defun org-clock-toggle-auto-clockout ()
   1565   (interactive)
   1566   (if (memq 'org-clock-auto-clockout org-clock-in-hook)
   1567       (progn (remove-hook 'org-clock-in-hook #'org-clock-auto-clockout)
   1568 	     (message "Auto clock-out after idle time turned off"))
   1569     (add-hook 'org-clock-in-hook #'org-clock-auto-clockout t)
   1570     (message "Auto clock-out after idle time turned on")))
   1571 
   1572 ;;;###autoload
   1573 (defun org-clock-in-last (&optional arg)
   1574   "Clock in the last closed clocked item.
   1575 When already clocking in, send a warning.
   1576 With a universal prefix argument, select the task you want to
   1577 clock in from the last clocked in tasks.
   1578 With two universal prefix arguments, start clocking using the
   1579 last clock-out time, if any.
   1580 With three universal prefix arguments, interactively prompt
   1581 for a todo state to switch to, overriding the existing value
   1582 `org-clock-in-switch-to-state'."
   1583   (interactive "P")
   1584   (if (equal arg '(4)) (org-clock-in arg)
   1585     (let ((start-time (if (or org-clock-continuously (equal arg '(16)))
   1586 			  (or org-clock-out-time
   1587 			      (org-current-time org-clock-rounding-minutes t))
   1588 			(org-current-time org-clock-rounding-minutes t))))
   1589       (if (null org-clock-history)
   1590 	  (message "No last clock")
   1591 	(let ((org-clock-in-switch-to-state
   1592 	       (if (and (not org-clock-current-task) (equal arg '(64)))
   1593 		   (completing-read "Switch to state: "
   1594 				    (and org-clock-history
   1595 					 (with-current-buffer
   1596 					     (marker-buffer (car org-clock-history))
   1597 					   org-todo-keywords-1)))
   1598 		 org-clock-in-switch-to-state))
   1599 	      (already-clocking org-clock-current-task))
   1600 	  (org-clock-clock-in (list (car org-clock-history)) nil start-time)
   1601 	  (or already-clocking
   1602 	      ;; Don't display a message if we are already clocking in
   1603 	      (message "Clocking back: %s (in %s)"
   1604 		       org-clock-current-task
   1605 		       (buffer-name (marker-buffer org-clock-marker)))))))))
   1606 
   1607 (defun org-clock-mark-default-task ()
   1608   "Mark current task as default task."
   1609   (interactive)
   1610   (save-excursion
   1611     (org-back-to-heading t)
   1612     (move-marker org-clock-default-task (point))))
   1613 
   1614 (defun org-clock-get-sum-start ()
   1615   "Return the time from which clock times should be counted.
   1616 
   1617 This is for the currently running clock as it is displayed in the
   1618 mode line.  This function looks at the properties LAST_REPEAT and
   1619 in particular CLOCK_MODELINE_TOTAL and the corresponding variable
   1620 `org-clock-mode-line-total' and then decides which time to use.
   1621 
   1622 The time is always returned as UTC."
   1623   (let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL" 'selective)
   1624 		 (symbol-name org-clock-mode-line-total)))
   1625 	(lr (org-entry-get nil "LAST_REPEAT")))
   1626     (cond
   1627      ((equal cmt "current")
   1628       (setq org--msg-extra "showing time in current clock instance")
   1629       (current-time))
   1630      ((equal cmt "today")
   1631       (setq org--msg-extra "showing today's task time.")
   1632       (let* ((dt (decode-time))
   1633 	     (hour (nth 2 dt))
   1634 	     (day (nth 3 dt)))
   1635 	(if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day)))
   1636 	(setf (nth 2 dt) org-extend-today-until)
   1637 	(org-encode-time (apply #'list 0 0 (nthcdr 2 dt)))))
   1638      ((or (equal cmt "all")
   1639 	  (and (or (not cmt) (equal cmt "auto"))
   1640 	       (not lr)))
   1641       (setq org--msg-extra "showing entire task time.")
   1642       nil)
   1643      ((or (equal cmt "repeat")
   1644 	  (and (or (not cmt) (equal cmt "auto"))
   1645 	       lr))
   1646       (setq org--msg-extra "showing task time since last repeat.")
   1647       (and lr (org-time-string-to-time lr)))
   1648      (t nil))))
   1649 
   1650 (defun org-clock-find-position (find-unclosed)
   1651   "Find the location where the next clock line should be inserted.
   1652 When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock
   1653 line and position cursor in that line."
   1654   (org-back-to-heading t)
   1655   (catch 'exit
   1656     (let* ((beg (line-beginning-position))
   1657 	   (end (save-excursion (outline-next-heading) (point)))
   1658 	   (org-clock-into-drawer (org-clock-into-drawer))
   1659 	   (drawer (org-clock-drawer-name)))
   1660       ;; Look for a running clock if FIND-UNCLOSED in non-nil.
   1661       (when find-unclosed
   1662 	(let ((open-clock-re
   1663 	       (concat "^[ \t]*"
   1664 		       org-clock-string
   1665 		       " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
   1666 		       " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
   1667 	  (while (re-search-forward open-clock-re end t)
   1668 	    (let ((element (org-element-at-point)))
   1669 	      (when (and (org-element-type-p element 'clock)
   1670 			 (eq (org-element-property :status element) 'running))
   1671 		(forward-line 0)
   1672 		(throw 'exit t))))))
   1673       ;; Look for an existing clock drawer.
   1674       (when drawer
   1675 	(goto-char beg)
   1676 	(let ((drawer-re (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$")))
   1677 	  (while (re-search-forward drawer-re end t)
   1678 	    (let ((element (org-element-at-point)))
   1679 	      (when (org-element-type-p element 'drawer)
   1680 		(let ((cend (org-element-contents-end element)))
   1681 		  (if (and (not org-log-states-order-reversed) cend)
   1682 		      (goto-char cend)
   1683 		    (forward-line))
   1684 		  (throw 'exit t)))))))
   1685       (goto-char beg)
   1686       (let ((clock-re (concat "^[ \t]*" org-clock-string))
   1687 	    (count 0)
   1688 	    positions)
   1689 	;; Count the CLOCK lines and store their positions.
   1690 	(save-excursion
   1691 	  (while (re-search-forward clock-re end t)
   1692 	    (let ((element (org-element-at-point)))
   1693 	      (when (org-element-type-p element 'clock)
   1694 		(setq positions (cons (line-beginning-position) positions)
   1695 		      count (1+ count))))))
   1696 	(cond
   1697 	 ((null positions)
   1698           (org-fold-core-ignore-modifications
   1699 	    ;; Skip planning line and property drawer, if any.
   1700 	    (org-end-of-meta-data)
   1701 	    (unless (bolp) (insert-before-markers-and-inherit "\n"))
   1702 	    ;; Create a new drawer if necessary.
   1703 	    (when (and org-clock-into-drawer
   1704 		       (or (not (wholenump org-clock-into-drawer))
   1705 			   (< org-clock-into-drawer 2)))
   1706 	      (let ((beg (point)))
   1707                 ;; Make sure that point moves after drawer upon
   1708                 ;; inserting it.  Then, users can continue typing even
   1709                 ;; if point was right where the clock is inserted.
   1710 	        (insert-before-markers-and-inherit ":" drawer ":\n:END:\n")
   1711 	        (org-indent-region beg (point))
   1712                 (org-fold-region (line-end-position -1) (1- (point)) t 'drawer)
   1713 	        (forward-line -1)))))
   1714 	 ;; When a clock drawer needs to be created because of the
   1715 	 ;; number of clock items or simply if it is missing, collect
   1716 	 ;; all clocks in the section and wrap them within the drawer.
   1717 	 ((if (wholenump org-clock-into-drawer)
   1718 	      (>= (1+ count) org-clock-into-drawer)
   1719 	    drawer)
   1720 	  ;; Skip planning line and property drawer, if any.
   1721 	  (org-end-of-meta-data)
   1722           (org-fold-core-ignore-modifications
   1723 	    (let ((beg (point)))
   1724 	      (insert-and-inherit
   1725 	       (mapconcat
   1726 	        (lambda (p)
   1727 		  (save-excursion
   1728 		    (goto-char p)
   1729 		    (org-trim (delete-and-extract-region
   1730 			       (save-excursion (skip-chars-backward " \r\t\n")
   1731 					       (line-beginning-position 2))
   1732 			       (line-beginning-position 2)))))
   1733 	        positions "\n")
   1734 	       "\n:END:\n")
   1735 	      (let ((end (point-marker)))
   1736 	        (goto-char beg)
   1737 	        (save-excursion (insert-before-markers-and-inherit ":" drawer ":\n"))
   1738 	        (org-fold-region (line-end-position) (1- end) t 'outline)
   1739 	        (org-indent-region (point) end)
   1740 	        (forward-line)
   1741 	        (unless org-log-states-order-reversed
   1742 		  (goto-char end)
   1743 		  (forward-line -2))
   1744 	        (set-marker end nil)))))
   1745 	 (org-log-states-order-reversed (goto-char (car (last positions))))
   1746 	 (t (goto-char (car positions))))))))
   1747 
   1748 (defun org-clock-restore-frame-title-format ()
   1749   "Restore `frame-title-format' from `org-frame-title-format-backup'.
   1750 `frame-title-format' is restored if `org-frame-title-format-backup' is not nil
   1751 and current `frame-title-format' is equal to `org-clock-frame-title-format'."
   1752   (when (and org-frame-title-format-backup
   1753 	     (equal frame-title-format org-clock-frame-title-format))
   1754     (setq frame-title-format org-frame-title-format-backup)))
   1755 
   1756 (defvar org-clock-out-removed-last-clock nil
   1757   "When non-nil, the last `org-clock-out' removed the clock line.
   1758 This can happen when `org-clock-out-remove-zero-time-clocks' is set to
   1759 non-nil and the latest clock took 0 minutes.")
   1760 
   1761 ;;;###autoload
   1762 (defun org-clock-out (&optional switch-to-state fail-quietly at-time)
   1763   "Stop the currently running clock.
   1764 Throw an error if there is no running clock and FAIL-QUIETLY is nil.
   1765 With a universal prefix, prompt for a state to switch the clocked out task
   1766 to, overriding the existing value of `org-clock-out-switch-to-state'."
   1767   (interactive "P")
   1768   (catch 'exit
   1769     (when (not (org-clocking-p))
   1770       (setq global-mode-string
   1771 	    (delq 'org-mode-line-string global-mode-string))
   1772       (org-clock-restore-frame-title-format)
   1773       (force-mode-line-update)
   1774       (if fail-quietly (throw 'exit t) (user-error "No active clock")))
   1775     (let ((org-clock-out-switch-to-state
   1776 	   (if switch-to-state
   1777 	       (completing-read "Switch to state: "
   1778 				(with-current-buffer
   1779 				    (marker-buffer org-clock-marker)
   1780 				  org-todo-keywords-1)
   1781 				nil t "DONE")
   1782 	     org-clock-out-switch-to-state))
   1783 	  (now (org-current-time org-clock-rounding-minutes))
   1784 	  ts te s h m remove)
   1785       (setq org-clock-out-time (or at-time now))
   1786       (save-excursion ; Do not replace this with `with-current-buffer'.
   1787 	(with-no-warnings (set-buffer (org-clocking-buffer)))
   1788 	(save-restriction
   1789 	  (widen)
   1790 	  (goto-char org-clock-marker)
   1791 	  (forward-line 0)
   1792 	  (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
   1793 		   (equal (match-string 1) org-clock-string))
   1794 	      (setq ts (match-string 2))
   1795 	    (if fail-quietly (throw 'exit nil) (error "Clock start time is gone")))
   1796 	  (goto-char (match-end 0))
   1797 	  (delete-region (point) (line-end-position))
   1798           (org-fold-core-ignore-modifications
   1799             (insert-and-inherit "--")
   1800             (setq te (org-insert-timestamp (or at-time now) 'with-hm 'inactive))
   1801             (setq s (org-time-convert-to-integer
   1802 	             (time-subtract
   1803 	              (org-time-string-to-time te)
   1804 	              (org-time-string-to-time ts)))
   1805 	          h (floor s 3600)
   1806 	          m (floor (mod s 3600) 60))
   1807             (insert-and-inherit " => " (format "%2d:%02d" h m))
   1808             (move-marker org-clock-marker nil)
   1809             (move-marker org-clock-hd-marker nil)
   1810             ;; Possibly remove zero time clocks.
   1811             (when (and org-clock-out-remove-zero-time-clocks
   1812 	               (= 0 h m))
   1813               (setq remove t)
   1814               (delete-region (line-beginning-position)
   1815 		             (line-beginning-position 2)))
   1816             (org-clock-remove-empty-clock-drawer))
   1817 	  (when org-clock-mode-line-timer
   1818 	    (cancel-timer org-clock-mode-line-timer)
   1819 	    (setq org-clock-mode-line-timer nil))
   1820 	  (when org-clock-idle-timer
   1821 	    (cancel-timer org-clock-idle-timer)
   1822 	    (setq org-clock-idle-timer nil))
   1823 	  (setq global-mode-string
   1824 		(delq 'org-mode-line-string global-mode-string))
   1825 	  (org-clock-restore-frame-title-format)
   1826 	  (when org-clock-out-switch-to-state
   1827 	    (save-excursion
   1828 	      (org-back-to-heading t)
   1829 	      (let ((org-clock-out-when-done nil))
   1830 		(cond
   1831 		 ((functionp org-clock-out-switch-to-state)
   1832 		  (let ((case-fold-search nil))
   1833 		    (looking-at org-complex-heading-regexp))
   1834 		  (let ((newstate (funcall org-clock-out-switch-to-state
   1835 					   (match-string 2))))
   1836 		    (when newstate (org-todo newstate))))
   1837 		 ((and org-clock-out-switch-to-state
   1838 		       (not (looking-at
   1839                              (concat
   1840                               org-outline-regexp "[ \t]*"
   1841 			      org-clock-out-switch-to-state
   1842 			      "\\(?:[ \t]\\|$\\)"))))
   1843 		  (org-todo org-clock-out-switch-to-state))))))
   1844 	  (force-mode-line-update)
   1845 	  (message (if remove
   1846 		       "Clock stopped at %s after %s => LINE REMOVED"
   1847 		     "Clock stopped at %s after %s")
   1848 		   te (org-duration-from-minutes (+ (* 60 h) m)))
   1849           (unless (org-clocking-p)
   1850 	    (setq org-clock-current-task nil))
   1851           (setq org-clock-out-removed-last-clock remove)
   1852           (run-hooks 'org-clock-out-hook)
   1853           ;; Add a note, but only if we didn't remove the clock line.
   1854           (when (and org-log-note-clock-out (not remove))
   1855             (org-add-log-setup
   1856 	     'clock-out nil nil nil
   1857 	     (concat "# Task: " (org-get-heading t) "\n\n"))))))))
   1858 
   1859 (defun org-clock-remove-empty-clock-drawer ()
   1860   "Remove empty clock drawers in current subtree."
   1861   (save-excursion
   1862     (org-back-to-heading t)
   1863     (org-map-tree
   1864      (lambda ()
   1865        (let ((drawer (org-clock-drawer-name))
   1866 	     (case-fold-search t))
   1867 	 (when drawer
   1868 	   (let ((re (format "^[ \t]*:%s:[ \t]*$" (regexp-quote drawer)))
   1869 		 (end (save-excursion (outline-next-heading))))
   1870 	     (while (re-search-forward re end t)
   1871 	       (org-remove-empty-drawer-at (point))))))))))
   1872 
   1873 (defun org-clock-timestamps-up (&optional n)
   1874   "Increase CLOCK timestamps at cursor.
   1875 Optional argument N tells to change by that many units."
   1876   (interactive "P")
   1877   (org-clock-timestamps-change 'up n))
   1878 
   1879 (defun org-clock-timestamps-down (&optional n)
   1880   "Decrease CLOCK timestamps at cursor.
   1881 Optional argument N tells to change by that many units."
   1882   (interactive "P")
   1883   (org-clock-timestamps-change 'down n))
   1884 
   1885 (defun org-clock-timestamps-change (updown &optional n)
   1886   "Change CLOCK timestamps synchronously at cursor.
   1887 UPDOWN tells whether to change `up' or `down'.
   1888 Optional argument N tells to change by that many units."
   1889   (let ((tschange (if (eq updown 'up) 'org-timestamp-up
   1890 		    'org-timestamp-down))
   1891 	(timestamp? (org-at-timestamp-p 'lax))
   1892 	ts1 begts1 ts2 begts2 updatets1 tdiff)
   1893     (when timestamp?
   1894       (save-excursion
   1895 	(move-beginning-of-line 1)
   1896 	(re-search-forward org-ts-regexp3 nil t)
   1897 	(setq ts1 (match-string 0) begts1 (match-beginning 0))
   1898 	(when (re-search-forward org-ts-regexp3 nil t)
   1899 	  (setq ts2 (match-string 0) begts2 (match-beginning 0))))
   1900       ;; Are we on the second timestamp?
   1901       (if (<= begts2 (point)) (setq updatets1 t))
   1902       (if (not ts2)
   1903 	  ;; fall back on org-timestamp-up if there is only one
   1904 	  (funcall tschange n)
   1905 	(funcall tschange n)
   1906 	(let ((ts (if updatets1 ts2 ts1))
   1907 	      (begts (if updatets1 begts1 begts2)))
   1908 	  (setq tdiff
   1909 		(time-subtract
   1910 		 (org-time-string-to-time
   1911                   (save-excursion
   1912                     (goto-char (if updatets1 begts2 begts1))
   1913                     (looking-at org-ts-regexp3)
   1914                     (match-string 0)))
   1915 		 (org-time-string-to-time ts)))
   1916           ;; `save-excursion' won't work because
   1917           ;; `org-timestamp-change' deletes and re-inserts the
   1918           ;; timestamp.
   1919 	  (let ((origin (point)))
   1920             (save-excursion
   1921 	      (goto-char begts)
   1922 	      (org-timestamp-change
   1923 	       (round (/ (float-time tdiff)
   1924 		         (pcase timestamp?
   1925 			   (`minute 60)
   1926 			   (`hour 3600)
   1927 			   (`day (* 24 3600))
   1928 			   (`month (* 24 3600 31))
   1929 			   (`year (* 24 3600 365.2)))))
   1930 	       timestamp? 'updown))
   1931             ;; Move back to initial position, but never beyond updated
   1932             ;; clock.
   1933             (unless (< (point) origin)
   1934               (goto-char origin))))))))
   1935 
   1936 ;;;###autoload
   1937 (defun org-clock-cancel ()
   1938   "Cancel the running clock by removing the start timestamp."
   1939   (interactive)
   1940   (when (not (org-clocking-p))
   1941     (setq global-mode-string
   1942 	  (delq 'org-mode-line-string global-mode-string))
   1943     (org-clock-restore-frame-title-format)
   1944     (force-mode-line-update)
   1945     (user-error "No active clock"))
   1946   (save-excursion    ; Do not replace this with `with-current-buffer'.
   1947     (with-no-warnings (set-buffer (org-clocking-buffer)))
   1948     (goto-char org-clock-marker)
   1949     (if (looking-back (concat "^[ \t]*" org-clock-string ".*")
   1950 		      (line-beginning-position))
   1951         (progn (delete-region (1- (line-beginning-position)) (line-end-position))
   1952 	       (org-remove-empty-drawer-at (point)))
   1953       (message "Clock gone, cancel the timer anyway")
   1954       (sit-for 2)))
   1955   (move-marker org-clock-marker nil)
   1956   (move-marker org-clock-hd-marker nil)
   1957   (setq org-clock-current-task nil)
   1958   (setq global-mode-string
   1959 	(delq 'org-mode-line-string global-mode-string))
   1960   (org-clock-restore-frame-title-format)
   1961   (force-mode-line-update)
   1962   (message "Clock canceled")
   1963   (run-hooks 'org-clock-cancel-hook))
   1964 
   1965 ;;;###autoload
   1966 (defun org-clock-goto (&optional select)
   1967   "Go to the currently clocked-in entry, or to the most recently clocked one.
   1968 With prefix arg SELECT, offer recently clocked tasks for selection."
   1969   (interactive "@P")
   1970   (let* ((recent nil)
   1971 	 (m (cond
   1972 	     (select
   1973 	      (or (org-clock-select-task "Select task to go to: ")
   1974 		  (user-error "No task selected")))
   1975 	     ((org-clocking-p) org-clock-marker)
   1976 	     ((and org-clock-goto-may-find-recent-task
   1977 		   (car org-clock-history)
   1978 		   (marker-buffer (car org-clock-history)))
   1979 	      (setq recent t)
   1980 	      (car org-clock-history))
   1981 	     (t (user-error "No active or recent clock task")))))
   1982     (pop-to-buffer-same-window (marker-buffer m))
   1983     (if (or (< m (point-min)) (> m (point-max))) (widen))
   1984     (goto-char m)
   1985     (org-fold-show-entry)
   1986     (org-back-to-heading t)
   1987     (recenter org-clock-goto-before-context)
   1988     (org-fold-reveal)
   1989     (if recent
   1990 	(message "No running clock, this is the most recently clocked task"))
   1991     (run-hooks 'org-clock-goto-hook)))
   1992 
   1993 (defvar-local org-clock-file-total-minutes nil
   1994   "Holds the file total time in minutes, after a call to `org-clock-sum'.")
   1995 
   1996 ;;;###autoload
   1997 (defun org-clock-sum-today (&optional headline-filter)
   1998   "Sum the times for each subtree for today."
   1999   (let ((range (org-clock-special-range 'today)))
   2000     (org-clock-sum (car range) (cadr range)
   2001 		   headline-filter :org-clock-minutes-today)))
   2002 
   2003 (defun org-clock-sum-custom (&optional headline-filter range propname)
   2004   "Sum the times for each subtree for today."
   2005   (let ((r (or (and (symbolp range) (org-clock-special-range range))
   2006 	       (org-clock-special-range
   2007 		(intern (completing-read
   2008 			 "Range: "
   2009 			 '("today" "yesterday" "thisweek" "lastweek"
   2010 			   "thismonth" "lastmonth" "thisyear" "lastyear"
   2011 			   "interactive")
   2012 			 nil t))))))
   2013     (org-clock-sum (car r) (cadr r)
   2014 		   headline-filter (or propname :org-clock-minutes-custom))))
   2015 
   2016 ;;;###autoload
   2017 (defun org-clock-sum (&optional tstart tend headline-filter propname)
   2018   "Sum the times for each subtree.
   2019 Puts the resulting times in minutes as a text property on each headline.
   2020 TSTART and TEND can mark a time range to be considered.
   2021 HEADLINE-FILTER is a zero-arg function that, if specified, is called for
   2022 each headline in the time range with point at the headline.  Headlines for
   2023 which HEADLINE-FILTER returns nil are excluded from the clock summation.
   2024 PROPNAME lets you set a custom text property instead of :org-clock-minutes."
   2025   (with-silent-modifications
   2026     (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
   2027 		       org-clock-string
   2028 		       "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)"))
   2029 	   (lmax 30)
   2030 	   (ltimes (make-vector lmax 0))
   2031 	   (level 0)
   2032 	   (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart))
   2033 			 ((consp tstart) (float-time tstart))
   2034 			 (t tstart)))
   2035 	   (tend (cond ((stringp tend) (org-time-string-to-seconds tend))
   2036 		       ((consp tend) (float-time tend))
   2037 		       (t tend)))
   2038 	   (t1 0)
   2039 	   time)
   2040       (remove-text-properties (point-min) (point-max)
   2041 			      `(,(or propname :org-clock-minutes) t
   2042 				:org-clock-force-headline-inclusion t))
   2043       (save-excursion
   2044 	(goto-char (point-max))
   2045 	(while (re-search-backward re nil t)
   2046           (let* ((element (save-match-data (org-element-at-point)))
   2047                  (element-type (org-element-type element)))
   2048 	    (cond
   2049 	     ((and (eq element-type 'clock) (match-end 2))
   2050 	      ;; Two time stamps.
   2051               (condition-case nil
   2052 	          (let* ((timestamp (org-element-property :value element))
   2053 		         (ts (float-time
   2054                               (org-encode-time
   2055                                (list 0
   2056                                      (org-element-property :minute-start timestamp)
   2057                                      (org-element-property :hour-start timestamp)
   2058                                      (org-element-property :day-start timestamp)
   2059                                      (org-element-property :month-start timestamp)
   2060                                      (org-element-property :year-start timestamp)
   2061                                      nil -1 nil))))
   2062 		         (te (float-time
   2063                               (org-encode-time
   2064                                (list 0
   2065                                      (org-element-property :minute-end timestamp)
   2066                                      (org-element-property :hour-end timestamp)
   2067                                      (org-element-property :day-end timestamp)
   2068                                      (org-element-property :month-end timestamp)
   2069                                      (org-element-property :year-end timestamp)
   2070                                      nil -1 nil))))
   2071 		         (dt (- (if tend (min te tend) te)
   2072 			        (if tstart (max ts tstart) ts))))
   2073 	            (when (> dt 0) (cl-incf t1 (floor dt 60))))
   2074                 (error
   2075                  (org-display-warning (format "org-clock-sum: Ignoring invalid %s" (org-current-line-string))))))
   2076 	     ((match-end 4)
   2077 	      ;; A naked time.
   2078 	      (setq t1 (+ t1 (string-to-number (match-string 5))
   2079 			  (* 60 (string-to-number (match-string 4))))))
   2080 	     ((memq element-type '(headline inlinetask)) ;A headline
   2081 	      ;; Add the currently clocking item time to the total.
   2082 	      (when (and org-clock-report-include-clocking-task
   2083 		         (eq (org-clocking-buffer) (current-buffer))
   2084 		         (eq (marker-position org-clock-hd-marker) (point))
   2085 		         tstart
   2086 		         tend
   2087 		         (>= (float-time org-clock-start-time) tstart)
   2088 		         (<= (float-time org-clock-start-time) tend))
   2089 	        (let ((time (floor (org-time-convert-to-integer
   2090 				    (time-since org-clock-start-time))
   2091 				   60)))
   2092 		  (setq t1 (+ t1 time))))
   2093 	      (let* ((headline-forced
   2094 		      (get-text-property (point)
   2095 				         :org-clock-force-headline-inclusion))
   2096 		     (headline-included
   2097 		      (or (null headline-filter)
   2098 			  (save-excursion
   2099 			    (save-match-data (funcall headline-filter))))))
   2100 	        (setq level (- (match-end 1) (match-beginning 1)))
   2101 	        (when (>= level lmax)
   2102 		  (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
   2103 	        (when (or (> t1 0) (> (aref ltimes level) 0))
   2104 		  (when (or headline-included headline-forced)
   2105 		    (if headline-included
   2106 		        (cl-loop for l from 0 to level do
   2107 			         (aset ltimes l (+ (aref ltimes l) t1))))
   2108 		    (setq time (aref ltimes level))
   2109 		    (goto-char (match-beginning 0))
   2110                     (put-text-property (point) (line-end-position)
   2111 				       (or propname :org-clock-minutes) time)
   2112 		    (when headline-filter
   2113 		      (save-excursion
   2114 		        (save-match-data
   2115 			  (while (org-up-heading-safe)
   2116 			    (put-text-property
   2117 			     (point) (line-end-position)
   2118 			     :org-clock-force-headline-inclusion t))))))
   2119 		  (setq t1 0)
   2120 		  (cl-loop for l from level to (1- lmax) do
   2121 			   (aset ltimes l 0))))))))
   2122 	(setq org-clock-file-total-minutes (aref ltimes 0))))))
   2123 
   2124 (defun org-clock-sum-current-item (&optional tstart)
   2125   "Return time, clocked on current item in total."
   2126   (save-excursion
   2127     (save-restriction
   2128       (if (and (featurep 'org-inlinetask)
   2129 	       (or (org-inlinetask-at-task-p)
   2130 		   (org-inlinetask-in-task-p)))
   2131 	  (narrow-to-region (save-excursion (org-inlinetask-goto-beginning) (point))
   2132 			    (save-excursion (org-inlinetask-goto-end) (point)))
   2133 	(org-narrow-to-subtree))
   2134       (org-clock-sum tstart)
   2135       org-clock-file-total-minutes)))
   2136 
   2137 ;;;###autoload
   2138 (defun org-clock-display (&optional arg)
   2139   "Show subtree times in the entire buffer.
   2140 
   2141 By default, show the total time for the range defined in
   2142 `org-clock-display-default-range'.  With `\\[universal-argument]' \
   2143 prefix, show
   2144 the total time for today instead.
   2145 
   2146 With `\\[universal-argument] \\[universal-argument]' prefix, \
   2147 use a custom range, entered at prompt.
   2148 
   2149 With `\\[universal-argument] \ \\[universal-argument] \
   2150 \\[universal-argument]' prefix, display the total time in the
   2151 echo area.
   2152 
   2153 Use `\\[org-clock-remove-overlays]' to remove the subtree times."
   2154   (interactive "P")
   2155   (org-clock-remove-overlays)
   2156   (let* ((todayp (equal arg '(4)))
   2157 	 (customp (member arg '((16) today yesterday
   2158 				thisweek lastweek thismonth
   2159 				lastmonth thisyear lastyear
   2160 				untilnow interactive)))
   2161 	 (prop (cond ((not arg) :org-clock-minutes-default)
   2162 		     (todayp :org-clock-minutes-today)
   2163 		     (customp :org-clock-minutes-custom)
   2164 		     (t :org-clock-minutes))))
   2165     (cond ((not arg) (org-clock-sum-custom
   2166 		      nil org-clock-display-default-range prop))
   2167 	  (todayp (org-clock-sum-today))
   2168 	  (customp (org-clock-sum-custom nil arg))
   2169 	  (t (org-clock-sum)))
   2170     (unless (equal arg '(64))
   2171       (save-excursion
   2172 	(goto-char (point-min))
   2173 	(let ((p nil))
   2174 	  (while (or (and (equal (setq p (point)) (point-min))
   2175 			  (get-text-property p prop))
   2176 		     (setq p (next-single-property-change (point) prop)))
   2177 	    (goto-char p)
   2178 	    (let ((time (get-text-property p prop)))
   2179 	      (when time (org-clock-put-overlay time)))))
   2180 	;; Arrange to remove the overlays upon next change.
   2181 	(when org-remove-highlights-with-change
   2182 	  (add-hook 'before-change-functions #'org-clock-remove-overlays
   2183 		    nil 'local))))
   2184     (let* ((h (/ org-clock-file-total-minutes 60))
   2185 	   (m (- org-clock-file-total-minutes (* 60 h))))
   2186       (message (cond
   2187 		(todayp
   2188 		 "Total file time for today: %s (%d hours and %d minutes)")
   2189 		(customp
   2190 		 "Total file time (custom): %s (%d hours and %d minutes)")
   2191 		(t
   2192 		 "Total file time: %s (%d hours and %d minutes)"))
   2193 	       (org-duration-from-minutes org-clock-file-total-minutes)
   2194 	       h m))))
   2195 
   2196 (defvar-local org-clock-overlays nil)
   2197 (put 'org-clock-overlays 'permanent-local t)
   2198 
   2199 (defun org-clock-put-overlay (time)
   2200   "Put an overlay on the headline at point, displaying TIME.
   2201 Create a new overlay and store it in `org-clock-overlays', so
   2202 that it will be easy to remove.  This function assumes point is
   2203 on a headline."
   2204   (org-match-line org-complex-heading-regexp)
   2205   (goto-char (match-beginning 4))
   2206   (let* ((headline (match-string 4))
   2207 	 (text (concat headline
   2208 		       (org-add-props
   2209 			   (make-string
   2210 			    (max (- (- 60 (current-column))
   2211 				    (org-string-width headline)
   2212 				    (length (org-get-at-bol 'line-prefix)))
   2213 				 0)
   2214 			    ?\·)
   2215 			   '(face shadow))
   2216 		       (org-add-props
   2217 			   (format " %9s " (org-duration-from-minutes time))
   2218 			   '(face org-clock-overlay))))
   2219 	 (o (make-overlay (point) (line-end-position))))
   2220     (org-overlay-display o text)
   2221     (push o org-clock-overlays)))
   2222 
   2223 ;;;###autoload
   2224 (defun org-clock-remove-overlays (&optional _beg _end noremove)
   2225   "Remove the occur highlights from the buffer.
   2226 If NOREMOVE is nil, remove this function from the
   2227 `before-change-functions' in the current buffer."
   2228   (interactive)
   2229   (unless org-inhibit-highlight-removal
   2230     (mapc #'delete-overlay org-clock-overlays)
   2231     (setq org-clock-overlays nil)
   2232     (unless noremove
   2233       (remove-hook 'before-change-functions
   2234 		   #'org-clock-remove-overlays 'local))))
   2235 
   2236 ;;;###autoload
   2237 (defun org-clock-out-if-current ()
   2238   "Clock out if the current entry contains the running clock.
   2239 This is used to stop the clock after a TODO entry is marked DONE,
   2240 and is only done if the variable `org-clock-out-when-done' is not nil."
   2241   (when (and (org-clocking-p)
   2242 	     org-clock-out-when-done
   2243 	     (marker-buffer org-clock-marker)
   2244 	     (or (and (eq t org-clock-out-when-done)
   2245 		      (member org-state org-done-keywords))
   2246 		 (and (listp org-clock-out-when-done)
   2247 		      (member org-state org-clock-out-when-done)))
   2248 	     (equal (or (buffer-base-buffer (org-clocking-buffer))
   2249 			(org-clocking-buffer))
   2250 		    (or (buffer-base-buffer (current-buffer))
   2251 			(current-buffer)))
   2252 	     (< (point) org-clock-marker)
   2253 	     (> (org-with-wide-buffer (org-entry-end-position))
   2254 		org-clock-marker))
   2255     ;; Clock out, but don't accept a logging message for this.
   2256     (let ((org-log-note-clock-out nil)
   2257 	  (org-clock-out-switch-to-state nil))
   2258       (org-clock-out))))
   2259 
   2260 ;;;###autoload
   2261 (defun org-clock-get-clocktable (&rest props)
   2262   "Get a formatted clocktable with parameters according to PROPS.
   2263 The table is created in a temporary buffer, fully formatted and
   2264 fontified, and then returned."
   2265   ;; Set the defaults
   2266   (setq props (plist-put props :name "clocktable"))
   2267   (unless (plist-member props :maxlevel)
   2268     (setq props (plist-put props :maxlevel 2)))
   2269   (unless (plist-member props :scope)
   2270     (setq props (plist-put props :scope 'agenda)))
   2271   (with-temp-buffer
   2272     (org-mode)
   2273     (org-create-dblock props)
   2274     (org-update-dblock)
   2275     (font-lock-ensure)
   2276     (forward-line 2)
   2277     (buffer-substring (point) (progn
   2278 				(re-search-forward "^[ \t]*#\\+END" nil t)
   2279                                 (line-beginning-position)))))
   2280 
   2281 ;;;###autoload
   2282 (defun org-clock-report (&optional arg)
   2283   "Update or create a table containing a report about clocked time.
   2284 
   2285 If point is inside an existing clocktable block, update it.
   2286 Otherwise, insert a new one.
   2287 
   2288 The new table inherits its properties from the variable
   2289 `org-clock-clocktable-default-properties'.
   2290 
   2291 The scope of the clocktable, when not specified in the previous
   2292 variable, is `subtree' of the current heading when the function is
   2293 called from inside heading, and `file' elsewhere (before the first
   2294 heading).
   2295 
   2296 When called with a prefix argument, move to the first clock table
   2297 in the buffer and update it."
   2298   (interactive "P")
   2299   (org-clock-remove-overlays)
   2300   (when arg
   2301     (org-find-dblock "clocktable")
   2302     (org-fold-show-entry))
   2303   (pcase (org-in-clocktable-p)
   2304     (`nil
   2305      (org-create-dblock
   2306       (org-combine-plists
   2307        (list :scope (if (org-before-first-heading-p) 'file 'subtree))
   2308        org-clock-clocktable-default-properties
   2309        '(:name "clocktable"))))
   2310     (start (goto-char start)))
   2311   (org-update-dblock))
   2312 
   2313 ;;;###autoload
   2314 (eval-after-load 'org
   2315   '(progn
   2316      (org-dynamic-block-define "clocktable" #'org-clock-report)))
   2317 
   2318 (defun org-day-of-week (day month year)
   2319   "Return the day of the week as an integer."
   2320   (nth 6
   2321        (decode-time
   2322 	(date-to-time
   2323 	 (format "%d-%02d-%02dT00:00:00" year month day)))))
   2324 
   2325 (defun org-quarter-to-date (quarter year)
   2326   "Get the date (week day year) of the first day of a given quarter."
   2327   (let (startday)
   2328     (cond
   2329      ((= quarter 1)
   2330       (setq startday (org-day-of-week 1 1 year))
   2331       (cond
   2332        ((= startday 0)
   2333 	(list 52 7 (- year 1)))
   2334        ((= startday 6)
   2335 	(list 52 6 (- year 1)))
   2336        ((<= startday 4)
   2337 	(list 1 startday year))
   2338        ((> startday 4)
   2339 	(list 53 startday (- year 1)))
   2340        )
   2341       )
   2342      ((= quarter 2)
   2343       (setq startday (org-day-of-week 1 4 year))
   2344       (cond
   2345        ((= startday 0)
   2346 	(list 13 startday year))
   2347        ((< startday 4)
   2348 	(list 14 startday year))
   2349        ((>= startday 4)
   2350 	(list 13 startday year))
   2351        )
   2352       )
   2353      ((= quarter 3)
   2354       (setq startday (org-day-of-week 1 7 year))
   2355       (cond
   2356        ((= startday 0)
   2357 	(list 26 startday year))
   2358        ((< startday 4)
   2359 	(list 27 startday year))
   2360        ((>= startday 4)
   2361 	(list 26 startday year))
   2362        )
   2363       )
   2364      ((= quarter 4)
   2365       (setq startday (org-day-of-week 1 10 year))
   2366       (cond
   2367        ((= startday 0)
   2368 	(list 39 startday year))
   2369        ((<= startday 4)
   2370 	(list 40 startday year))
   2371        ((> startday 4)
   2372 	(list 39 startday year)))))))
   2373 
   2374 (defun org-clock-special-range (key &optional time as-strings wstart mstart)
   2375   "Return two times bordering a special time range.
   2376 
   2377 KEY is a symbol specifying the range and can be one of `today',
   2378 `yesterday', `thisweek', `lastweek', `thismonth', `lastmonth',
   2379 `thisyear', `lastyear' or `untilnow'.  If set to `interactive',
   2380 user is prompted for range boundaries.  It can be a string or an
   2381 integer.
   2382 
   2383 By default, a week starts Monday 0:00 and ends Sunday 24:00.  The
   2384 range is determined relative to TIME, which defaults to current
   2385 time.
   2386 
   2387 The return value is a list containing two internal times, one for
   2388 the beginning of the range and one for its end, like the ones
   2389 returned by `current-time' or `encode-time' and a string used to
   2390 display information.  If AS-STRINGS is non-nil, the returned
   2391 times will be formatted strings.  Note that the first element is
   2392 always nil when KEY is `untilnow'.
   2393 
   2394 If WSTART is non-nil, use this number to specify the starting day
   2395 of a week (monday is 1).  If MSTART is non-nil, use this number
   2396 to specify the starting day of a month (1 is the first day of the
   2397 month).  If you can combine both, the month starting day will
   2398 have priority."
   2399   (let* ((tm (decode-time time))
   2400 	 (m (nth 1 tm))
   2401 	 (h (nth 2 tm))
   2402 	 (d (nth 3 tm))
   2403 	 (month (nth 4 tm))
   2404 	 (y (nth 5 tm))
   2405 	 (dow (nth 6 tm))
   2406 	 (skey (format "%s" key))
   2407 	 (shift 0)
   2408 	 (q (cond ((>= month 10) 4)
   2409 		  ((>= month 7) 3)
   2410 		  ((>= month 4) 2)
   2411 		  (t 1)))
   2412 	 h1 d1 month1 y1 shiftedy shiftedm shiftedq) ;; m1
   2413     (cond
   2414      ((string-match "\\`[0-9]+\\'" skey)
   2415       (setq y (string-to-number skey) month 1 d 1 key 'year))
   2416      ((string-match "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)\\'" skey)
   2417       (setq y (string-to-number (match-string 1 skey))
   2418 	    month (string-to-number (match-string 2 skey))
   2419 	    d 1
   2420 	    key 'month))
   2421      ((string-match "\\`\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)\\'" skey)
   2422       (require 'cal-iso)
   2423       (let ((date (calendar-gregorian-from-absolute
   2424 		   (calendar-iso-to-absolute
   2425 		    (list (string-to-number (match-string 2 skey))
   2426 			  1
   2427 			  (string-to-number (match-string 1 skey)))))))
   2428 	(setq d (nth 1 date)
   2429 	      month (car date)
   2430 	      y (nth 2 date)
   2431 	      dow 1
   2432 	      key 'week)))
   2433      ((string-match "\\`\\([0-9]+\\)-[qQ]\\([1-4]\\)\\'" skey)
   2434       (require 'cal-iso)
   2435       (setq q (string-to-number (match-string 2 skey)))
   2436       (let ((date (calendar-gregorian-from-absolute
   2437 		   (calendar-iso-to-absolute
   2438 		    (org-quarter-to-date
   2439 		     q (string-to-number (match-string 1 skey)))))))
   2440 	(setq d (nth 1 date)
   2441 	      month (car date)
   2442 	      y (nth 2 date)
   2443 	      dow 1
   2444 	      key 'quarter)))
   2445      ((string-match
   2446        "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)\\'"
   2447        skey)
   2448       (setq y (string-to-number (match-string 1 skey))
   2449 	    month (string-to-number (match-string 2 skey))
   2450 	    d (string-to-number (match-string 3 skey))
   2451 	    key 'day))
   2452      ((string-match "\\([-+][0-9]+\\)\\'" skey)
   2453       (setq shift (string-to-number (match-string 1 skey))
   2454 	    key (intern (substring skey 0 (match-beginning 1))))
   2455       (when (and (memq key '(quarter thisq)) (> shift 0))
   2456 	(error "Looking forward with quarters isn't implemented"))))
   2457     (when (= shift 0)
   2458       (pcase key
   2459 	(`yesterday (setq key 'today   shift -1))
   2460 	(`lastweek  (setq key 'week    shift -1))
   2461 	(`lastmonth (setq key 'month   shift -1))
   2462 	(`lastyear  (setq key 'year    shift -1))
   2463 	(`lastq     (setq key 'quarter shift -1))))
   2464     ;; Prepare start and end times depending on KEY's type.
   2465     (pcase key
   2466       ((or `day `today) (setq m 0
   2467                               h org-extend-today-until
   2468                               h1 (+ 24 org-extend-today-until)
   2469                               d (+ d shift)))
   2470       ((or `week `thisweek)
   2471        (let* ((ws (or wstart 1))
   2472 	      (diff (+ (* -7 shift) (mod (+ dow 7 (- ws)) 7))))
   2473 	 (setq m 0 h org-extend-today-until d (- d diff) d1 (+ 7 d))))
   2474       ((or `month `thismonth)
   2475        (setq h org-extend-today-until m 0 d (or mstart 1)
   2476              month (+ month shift) month1 (1+ month)))
   2477       ((or `quarter `thisq)
   2478        ;; Compute if this shift remains in this year.  If not, compute
   2479        ;; how many years and quarters we have to shift (via floor*) and
   2480        ;; compute the shifted years, months and quarters.
   2481        (cond
   2482 	((< (+ (- q 1) shift) 0)	; Shift not in this year.
   2483 	 (let* ((interval (* -1 (+ (- q 1) shift)))
   2484 		;; Set tmp to ((years to shift) (quarters to shift)).
   2485 		(tmp (cl-floor interval 4)))
   2486 	   ;; Due to the use of floor, 0 quarters actually means 4.
   2487 	   (if (= 0 (nth 1 tmp))
   2488 	       (setq shiftedy (- y (nth 0 tmp))
   2489 		     shiftedm 1
   2490 		     shiftedq 1)
   2491 	     (setq shiftedy (- y (+ 1 (nth 0 tmp)))
   2492 		   shiftedm (- 13 (* 3 (nth 1 tmp)))
   2493 		   shiftedq (- 5 (nth 1 tmp)))))
   2494 	 (setq m 0 h org-extend-today-until d 1
   2495                month shiftedm month1 (+ 3 shiftedm) y shiftedy))
   2496 	((> (+ q shift) 0)		; Shift is within this year.
   2497 	 (setq shiftedq (+ q shift))
   2498 	 (setq shiftedy y)
   2499 	 (let ((qshift (* 3 (1- (+ q shift)))))
   2500 	   (setq m 0 h org-extend-today-until d 1
   2501                  month (+ 1 qshift) month1 (+ 4 qshift))))))
   2502       ((or `year `thisyear)
   2503        (setq m 0 h org-extend-today-until d 1 month 1 y (+ y shift) y1 (1+ y)))
   2504       ((or `interactive `untilnow))	; Special cases, ignore them.
   2505       (_ (user-error "No such time block %s" key)))
   2506     ;; Format start and end times according to AS-STRINGS.
   2507     (let* ((start (pcase key
   2508 		    (`interactive (org-read-date nil t nil "Range start? "))
   2509 		    (`untilnow nil)
   2510 		    (_ (org-encode-time 0 m h d month y))))
   2511 	   (end (pcase key
   2512 		  (`interactive (org-read-date nil t nil "Range end? "))
   2513 		  (`untilnow (current-time))
   2514 		  (_ (org-encode-time 0
   2515                                       m ;; (or m1 m)
   2516                                       (or h1 h)
   2517                                       (or d1 d)
   2518                                       (or month1 month)
   2519                                       (or y1 y)))))
   2520 	   (text
   2521 	    (pcase key
   2522 	      ((or `day `today) (format-time-string "%A, %B %d, %Y" start))
   2523 	      ((or `week `thisweek) (format-time-string "week %G-W%V" start))
   2524 	      ((or `month `thismonth) (format-time-string "%B %Y" start))
   2525 	      ((or `year `thisyear) (format-time-string "the year %Y" start))
   2526 	      ((or `quarter `thisq)
   2527 	       (concat (org-count-quarter shiftedq)
   2528 		       " quarter of " (number-to-string shiftedy)))
   2529 	      (`interactive "(Range interactively set)")
   2530 	      (`untilnow "now"))))
   2531       (if (not as-strings) (list start end text)
   2532 	(let ((f (org-time-stamp-format 'with-time)))
   2533 	  (list (and start (format-time-string f start))
   2534 		(format-time-string f end)
   2535 		text))))))
   2536 
   2537 (defun org-count-quarter (n)
   2538   (cond
   2539    ((= n 1) "1st")
   2540    ((= n 2) "2nd")
   2541    ((= n 3) "3rd")
   2542    ((= n 4) "4th")))
   2543 
   2544 ;;;###autoload
   2545 (defun org-clocktable-shift (dir n)
   2546   "Try to shift the :block date of the clocktable at point.
   2547 Point must be in the #+BEGIN: line of a clocktable, or this function
   2548 will throw an error.
   2549 DIR is a direction, a symbol `left', `right', `up', or `down'.
   2550 Both `left' and `down' shift the block toward the past, `up' and `right'
   2551 push it toward the future.
   2552 N is the number of shift steps to take.  The size of the step depends on
   2553 the currently selected interval size."
   2554   (setq n (prefix-numeric-value n))
   2555   (and (memq dir '(left down)) (setq n (- n)))
   2556   (save-excursion
   2557     (goto-char (line-beginning-position))
   2558     (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)"))
   2559 	(user-error "Line needs a :block definition before this command works")
   2560       (let* ((b (match-beginning 1)) (e (match-end 1))
   2561 	     (s (match-string 1))
   2562 	     block shift ins y mw d date wp) ;; m
   2563 	(cond
   2564 	 ((equal s "yesterday") (setq s "today-1"))
   2565 	 ((equal s "lastweek") (setq s "thisweek-1"))
   2566 	 ((equal s "lastmonth") (setq s "thismonth-1"))
   2567 	 ((equal s "lastyear") (setq s "thisyear-1"))
   2568 	 ((equal s "lastq") (setq s "thisq-1")))
   2569 
   2570 	(cond
   2571 	 ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s)
   2572 	  (setq block (match-string 1 s)
   2573 		shift (if (match-end 2)
   2574 			  (string-to-number (match-string 2 s))
   2575 			0))
   2576 	  (setq shift (+ shift n))
   2577 	  (setq ins (if (= shift 0) block (format "%s%+d" block shift))))
   2578 	 ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
   2579 	  ;;               1        1  2   3       3  4                  4  5   6                6  5   2
   2580 	  (setq y (string-to-number (match-string 1 s))
   2581 		wp (and (match-end 3) (match-string 3 s))
   2582 		mw (and (match-end 4) (string-to-number (match-string 4 s)))
   2583 		d (and (match-end 6) (string-to-number (match-string 6 s))))
   2584 	  (cond
   2585 	   (d (setq ins (format-time-string
   2586 			 "%Y-%m-%d"
   2587 			 (org-encode-time 0 0 0 (+ d n) nil y)))) ;; m
   2588 	   ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
   2589 	    (require 'cal-iso)
   2590 	    (setq date (calendar-gregorian-from-absolute
   2591 			(calendar-iso-to-absolute (list (+ mw n) 1 y))))
   2592 	    (setq ins (format-time-string
   2593 		       "%G-W%V"
   2594 		       (org-encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
   2595 	   ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
   2596 	    (require 'cal-iso)
   2597 					; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year
   2598 	    (if (> (+ mw n) 4)
   2599 		(setq mw 0
   2600 		      y (+ 1 y))
   2601 	      ())
   2602 					; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year
   2603 	    (if (= (+ mw n) 0)
   2604 		(setq mw 5
   2605 		      y (- y 1))
   2606 	      ())
   2607 	    (setq date (calendar-gregorian-from-absolute
   2608 			(calendar-iso-to-absolute (org-quarter-to-date (+ mw n) y))))
   2609 	    (setq ins (format-time-string
   2610 		       (concat (number-to-string y) "-Q" (number-to-string (+ mw n)))
   2611 		       (org-encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
   2612 	   (mw
   2613 	    (setq ins (format-time-string
   2614 		       "%Y-%m"
   2615 		       (org-encode-time 0 0 0 1 (+ mw n) y))))
   2616 	   (y
   2617 	    (setq ins (number-to-string (+ y n))))))
   2618 	 (t (user-error "Cannot shift clocktable block")))
   2619 	(when ins
   2620 	  (goto-char b)
   2621 	  (insert ins)
   2622 	  (delete-region (point) (+ (point) (- e b)))
   2623 	  (forward-line 0)
   2624 	  (org-update-dblock)
   2625 	  t)))))
   2626 
   2627 ;;;###autoload
   2628 (defun org-dblock-write:clocktable (params)
   2629   "Write the standard clocktable."
   2630   (setq params (org-combine-plists org-clocktable-defaults params))
   2631   (catch 'exit
   2632     (let* ((scope (plist-get params :scope))
   2633 	   (base-buffer (org-base-buffer (current-buffer)))
   2634 	   (files (pcase scope
   2635 		    (`agenda
   2636 		     (org-agenda-files t))
   2637 		    (`agenda-with-archives
   2638 		     (org-add-archive-files (org-agenda-files t)))
   2639 		    (`file-with-archives
   2640 		     (let ((base-file (buffer-file-name base-buffer)))
   2641 		       (and base-file
   2642 			    (org-add-archive-files (list base-file)))))
   2643 		    ((or `nil `file `subtree `tree
   2644 			 (and (pred symbolp)
   2645 			      (guard (string-match "\\`tree\\([0-9]+\\)\\'"
   2646 						   (symbol-name scope)))))
   2647 		     base-buffer)
   2648 		    ((pred functionp) (funcall scope))
   2649 		    ((pred consp) scope)
   2650 		    (_ (user-error "Unknown scope: %S" scope))))
   2651 	   (block (plist-get params :block))
   2652 	   (ts (plist-get params :tstart))
   2653 	   (te (plist-get params :tend))
   2654 	   (ws (plist-get params :wstart))
   2655 	   (ms (plist-get params :mstart))
   2656 	   (step (plist-get params :step))
   2657 	   (hide-files (plist-get params :hidefiles))
   2658 	   (formatter (or (plist-get params :formatter)
   2659 			  org-clock-clocktable-formatter
   2660 			  'org-clocktable-write-default))
   2661 	   cc)
   2662       ;; Check if we need to do steps
   2663       (when block
   2664 	;; Get the range text for the header
   2665 	(setq cc (org-clock-special-range block nil t ws ms)
   2666 	      ts (car cc)
   2667 	      te (nth 1 cc)))
   2668       (when step
   2669 	;; Write many tables, in steps
   2670 	(unless (or block (and ts te))
   2671 	  (user-error "Clocktable `:step' can only be used with `:block' or `:tstart', `:tend'"))
   2672 	(org-clocktable-steps params)
   2673 	(throw 'exit nil))
   2674 
   2675       (org-agenda-prepare-buffers (if (consp files) files (list files)))
   2676 
   2677       (let ((origin (point))
   2678 	    (tables
   2679 	     (if (consp files)
   2680 		 (mapcar (lambda (file)
   2681 			   (with-current-buffer (find-buffer-visiting file)
   2682 			     (save-excursion
   2683 			       (save-restriction
   2684 				 (org-clock-get-table-data file params)))))
   2685 			 files)
   2686 	       ;; Get the right restriction for the scope.
   2687 	       (save-restriction
   2688 		 (cond
   2689 		  ((not scope))	     ;use the restriction as it is now
   2690 		  ((eq scope 'file) (widen))
   2691 		  ((eq scope 'subtree) (org-narrow-to-subtree))
   2692 		  ((eq scope 'tree)
   2693 		   (while (org-up-heading-safe))
   2694 		   (org-narrow-to-subtree))
   2695 		  ((and (symbolp scope)
   2696 			(string-match "\\`tree\\([0-9]+\\)\\'"
   2697 				      (symbol-name scope)))
   2698 		   (let ((level (string-to-number
   2699 				 (match-string 1 (symbol-name scope)))))
   2700 		     (catch 'exit
   2701 		       (while (org-up-heading-safe)
   2702 			 (looking-at org-outline-regexp)
   2703 			 (when (<= (org-reduced-level (funcall outline-level))
   2704 				   level)
   2705 			   (throw 'exit nil))))
   2706 		     (org-narrow-to-subtree))))
   2707 		 (list (org-clock-get-table-data nil params)))))
   2708 	    (multifile
   2709 	     ;; Even though `file-with-archives' can consist of
   2710 	     ;; multiple files, we consider this is one extended file
   2711 	     ;; instead.
   2712 	     (and (not hide-files)
   2713 		  (consp files)
   2714 		  (not (eq scope 'file-with-archives)))))
   2715 
   2716 	(funcall formatter
   2717 		 origin
   2718 		 tables
   2719 		 (org-combine-plists params `(:multifile ,multifile)))))))
   2720 
   2721 (defun org-clocktable-write-default (ipos tables params)
   2722   "Write out a clock table at position IPOS in the current buffer.
   2723 TABLES is a list of tables with clocking data as produced by
   2724 `org-clock-get-table-data'.  PARAMS is the parameter property list obtained
   2725 from the dynamic block definition."
   2726   ;; This function looks quite complicated, mainly because there are a
   2727   ;; lot of options which can add or remove columns.  I have massively
   2728   ;; commented this function, the I hope it is understandable.  If
   2729   ;; someone wants to write their own special formatter, this maybe
   2730   ;; much easier because there can be a fixed format with a
   2731   ;; well-defined number of columns...
   2732   (let* ((lang (or (plist-get params :lang) "en"))
   2733 	 (multifile (plist-get params :multifile))
   2734 	 (block (plist-get params :block))
   2735 	 (sort (plist-get params :sort))
   2736 	 (header (plist-get params :header))
   2737 	 (link (plist-get params :link))
   2738 	 (maxlevel (or (plist-get params :maxlevel) 3))
   2739 	 (emph (plist-get params :emphasize))
   2740 	 (compact? (plist-get params :compact))
   2741 	 (narrow (or (plist-get params :narrow) (and compact? '40!)))
   2742 	 (filetitle (plist-get params :filetitle))
   2743 	 (level? (and (not compact?) (plist-get params :level)))
   2744 	 (timestamp (plist-get params :timestamp))
   2745 	 (tags (plist-get params :tags))
   2746 	 (properties (plist-get params :properties))
   2747 	 (time-columns
   2748 	  (if (or compact? (< maxlevel 2)) 1
   2749 	    ;; Deepest headline level is a hard limit for the number
   2750 	    ;; of time columns.
   2751 	    (let ((levels
   2752 		   (cl-mapcan
   2753 		    (lambda (table)
   2754 		      (pcase table
   2755 			(`(,_ ,(and (pred wholenump) (pred (/= 0))) ,entries)
   2756 			 (mapcar #'car entries))))
   2757 		    tables)))
   2758 	      (min maxlevel
   2759 		   (or (plist-get params :tcolumns) 100)
   2760 		   (if (null levels) 1 (apply #'max levels))))))
   2761 	 (indent (or compact? (plist-get params :indent)))
   2762 	 (formula (plist-get params :formula))
   2763 	 (case-fold-search t)
   2764 	 (total-time (apply #'+ (mapcar #'cadr tables)))
   2765 	 recalc narrow-cut-p)
   2766 
   2767     (when (and narrow (integerp narrow) link)
   2768       ;; We cannot have both integer narrow and link.
   2769       (message "Using hard narrowing in clocktable to allow for links")
   2770       (setq narrow (intern (format "%d!" narrow))))
   2771 
   2772     (pcase narrow
   2773       ((or `nil (pred integerp)) nil)	;nothing to do
   2774       ((and (pred symbolp)
   2775 	    (guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow))))
   2776        (setq narrow-cut-p t)
   2777        (setq narrow (string-to-number (symbol-name narrow))))
   2778       (_ (user-error "Invalid value %s of :narrow property in clock table" narrow)))
   2779 
   2780     ;; Now we need to output this table stuff.
   2781     (goto-char ipos)
   2782 
   2783     ;; Insert the text *before* the actual table.
   2784     (insert-before-markers
   2785      (or header
   2786 	 ;; Format the standard header.
   2787 	 (format "#+CAPTION: %s %s%s\n"
   2788 		 (org-clock--translate "Clock summary at" lang)
   2789 		 (format-time-string (org-time-stamp-format t t))
   2790 		 (if block
   2791 		     (let ((range-text
   2792 			    (nth 2 (org-clock-special-range
   2793 				    block nil t
   2794 				    (plist-get params :wstart)
   2795 				    (plist-get params :mstart)))))
   2796 		       (format ", for %s." range-text))
   2797 		   ""))))
   2798 
   2799     ;; Insert the narrowing line
   2800     (when (and narrow (integerp narrow) (not narrow-cut-p))
   2801       (insert-before-markers
   2802        "|"				;table line starter
   2803        (if multifile "|" "")		;file column, maybe
   2804        (if level? "|" "")		;level column, maybe
   2805        (if timestamp "|" "")		;timestamp column, maybe
   2806        (if tags "|" "")                 ;tags columns, maybe
   2807        (if properties			;properties columns, maybe
   2808 	   (make-string (length properties) ?|)
   2809 	 "")
   2810        (format "<%d>| |\n" narrow)))	;headline and time columns
   2811 
   2812     ;; Insert the table header line
   2813     (insert-before-markers
   2814      "|"				;table line starter
   2815      (if multifile			;file column, maybe
   2816 	 (concat (org-clock--translate "File" lang) "|")
   2817        "")
   2818      (if level?				;level column, maybe
   2819 	 (concat (org-clock--translate "L" lang) "|")
   2820        "")
   2821      (if timestamp			;timestamp column, maybe
   2822 	 (concat (org-clock--translate "Timestamp" lang) "|")
   2823        "")
   2824      (if tags "Tags |" "")              ;tags columns, maybe
   2825 
   2826      (if properties			;properties columns, maybe
   2827 	 (concat (mapconcat #'identity properties "|") "|")
   2828        "")
   2829      (concat (org-clock--translate "Headline" lang)"|")
   2830      (concat (org-clock--translate "Time" lang) "|")
   2831      (make-string (max 0 (1- time-columns)) ?|) ;other time columns
   2832      (if (eq formula '%) "%|\n" "\n"))
   2833 
   2834     ;; Insert the total time in the table
   2835     (insert-before-markers
   2836      "|-\n"				;a hline
   2837      "|"				;table line starter
   2838      (if multifile (format "| %s " (org-clock--translate "ALL" lang)) "")
   2839 					;file column, maybe
   2840      (if level?    "|" "")		;level column, maybe
   2841      (if timestamp "|" "")		;timestamp column, maybe
   2842      (if tags      "|" "")		;timestamp column, maybe
   2843      (make-string (length properties) ?|) ;properties columns, maybe
   2844      (concat (format org-clock-total-time-cell-format
   2845 		     (org-clock--translate "Total time" lang))
   2846 	     "| ")
   2847      (format org-clock-total-time-cell-format
   2848 	     (org-duration-from-minutes (or total-time 0))) ;time
   2849      "|"
   2850      (make-string (max 0 (1- time-columns)) ?|)
   2851      (cond ((not (eq formula '%)) "")
   2852 	   ((or (not total-time) (= total-time 0)) "0.0|")
   2853 	   (t  "100.0|"))
   2854      "\n")
   2855 
   2856     ;; Now iterate over the tables and insert the data but only if any
   2857     ;; time has been collected.
   2858     (when (and total-time (> total-time 0))
   2859       (pcase-dolist (`(,file-name ,file-time ,entries) tables)
   2860 	(when (or (and file-time (> file-time 0))
   2861 		  (not (plist-get params :fileskip0)))
   2862 	  (insert-before-markers "|-\n") ;hline at new file
   2863 	  ;; First the file time, if we have multiple files.
   2864 	  (when multifile
   2865 	    ;; Summarize the time collected from this file.
   2866 	    (insert-before-markers
   2867 	     (format (concat "| %s %s | %s%s%s"
   2868 			     (format org-clock-file-time-cell-format
   2869 				     (org-clock--translate "File time" lang))
   2870 
   2871 			     ;; The file-time rollup value goes in the first time
   2872 			     ;; column (of which there is always at least one)...
   2873 			     " | *%s*|"
   2874 			     ;; ...and the remaining file time cols (if any) are blank.
   2875 			     (make-string (max 0 (1- time-columns)) ?|)
   2876 
   2877 			     ;; Optionally show the percentage contribution of "this"
   2878 			     ;; file time to the total time.
   2879 			     (if (eq formula '%) " %s |" "")
   2880 			     "\n")
   2881 
   2882                      (if filetitle
   2883                          (or (org-get-title file-name)
   2884                              (file-name-nondirectory file-name))
   2885                        (file-name-nondirectory file-name))
   2886 		     (if level?    "| " "") ;level column, maybe
   2887 		     (if timestamp "| " "") ;timestamp column, maybe
   2888 		     (if tags      "| " "") ;tags column, maybe
   2889 		     (if properties	    ;properties columns, maybe
   2890 			 (make-string (length properties) ?|)
   2891 		       "")
   2892 		     (org-duration-from-minutes file-time) ;time
   2893 
   2894 		     (cond ((not (eq formula '%)) "")	   ;time percentage, maybe
   2895 			   ((or (not total-time) (= total-time 0)) "0.0")
   2896 			   (t
   2897 			    (format "%.1f" (* 100 (/ file-time (float total-time)))))))))
   2898 
   2899 	  ;; Get the list of node entries and iterate over it
   2900 	  (when (> maxlevel 0)
   2901 	    (pcase-dolist (`(,level ,headline ,tgs ,ts ,time ,props) entries)
   2902 	      (when narrow-cut-p
   2903 		(setq headline
   2904 		      (if (and (string-match
   2905 				(format "\\`%s\\'" org-link-bracket-re)
   2906 				headline)
   2907 			       (match-end 2))
   2908 			  (format "[[%s][%s]]"
   2909 				  (match-string 1 headline)
   2910 				  (org-shorten-string (match-string 2 headline)
   2911 						      narrow))
   2912 			(org-shorten-string headline narrow))))
   2913 	      (cl-flet ((format-field (f) (format (cond ((not emph) "%s |")
   2914 							((= level 1) "*%s* |")
   2915 							((= level 2) "/%s/ |")
   2916 							(t "%s |"))
   2917 						  f)))
   2918 		(insert-before-markers
   2919 		 "|"		       ;start the table line
   2920 		 (if multifile "|" "") ;free space for file name column?
   2921 		 (if level? (format "%d|" level) "") ;level, maybe
   2922 		 (if timestamp (concat ts "|") "")   ;timestamp, maybe
   2923 		 (if tags (concat (mapconcat #'identity tgs ", ") "|") "")   ;tags, maybe
   2924 		 (if properties		;properties columns, maybe
   2925 		     (concat (mapconcat (lambda (p) (or (cdr (assoc p props)) ""))
   2926 				        properties
   2927 				        "|")
   2928 			     "|")
   2929 		   "")
   2930 		 (if indent		;indentation
   2931 		     (org-clocktable-indent-string level)
   2932 		   "")
   2933 		 (format-field headline)
   2934 		 ;; Empty fields for higher levels.
   2935 		 (make-string (max 0 (1- (min time-columns level))) ?|)
   2936 		 (format-field (org-duration-from-minutes time))
   2937 		 (make-string (max 0 (- time-columns level)) ?|)
   2938 		 (if (eq formula '%)
   2939 		     (format "%.1f |" (* 100 (/ time (float total-time))))
   2940 		   "")
   2941 		 "\n")))))))
   2942     (delete-char -1)
   2943     (cond
   2944      ;; Possibly rescue old formula?
   2945      ((or (not formula) (eq formula '%))
   2946       (let ((contents (org-string-nw-p (plist-get params :content))))
   2947 	(when (and contents (string-match "^\\([ \t]*#\\+tblfm:.*\\)" contents))
   2948 	  (setq recalc t)
   2949 	  (insert "\n" (match-string 1 contents))
   2950 	  (forward-line -1))))
   2951      ;; Insert specified formula line.
   2952      ((stringp formula)
   2953       (insert "\n#+TBLFM: " formula)
   2954       (setq recalc t))
   2955      (t
   2956       (user-error "Invalid :formula parameter in clocktable")))
   2957     ;; Back to beginning, align the table, recalculate if necessary.
   2958     (goto-char ipos)
   2959     (skip-chars-forward "^|")
   2960     (org-table-align)
   2961     (when org-hide-emphasis-markers
   2962       ;; We need to align a second time.
   2963       (org-table-align))
   2964     (when sort
   2965       (save-excursion
   2966 	(org-table-goto-line 3)
   2967 	(org-table-goto-column (car sort))
   2968 	(org-table-sort-lines nil (cdr sort))))
   2969     (when recalc (org-table-recalculate 'all))
   2970     total-time))
   2971 
   2972 (defun org-clocktable-indent-string (level)
   2973   "Return indentation string according to LEVEL.
   2974 LEVEL is an integer.  Indent by two spaces per level above 1."
   2975   (if (= level 1) ""
   2976     (concat "\\_" (make-string (* 2 (1- level)) ?\s))))
   2977 
   2978 (defun org-clocktable-steps (params)
   2979   "Create one or more clock tables, according to PARAMS.
   2980 Step through the range specifications in plist PARAMS to make
   2981 a number of clock tables."
   2982   (let* ((ignore-empty-tables (plist-get params :stepskip0))
   2983          (step (plist-get params :step))
   2984          (step-header
   2985           (pcase step
   2986             (`day "Daily report: ")
   2987             (`week "Weekly report starting on: ")
   2988             (`semimonth "Semimonthly report starting on: ")
   2989             (`month "Monthly report starting on: ")
   2990             (`year "Annual report starting on: ")
   2991             (`quarter "Quarterly report starting on: ")
   2992             (_ (user-error "Unknown `:step' specification: %S" step))))
   2993          (week-start (or (plist-get params :wstart) 1))
   2994          (month-start (or (plist-get params :mstart) 1))
   2995          (range
   2996           (pcase (plist-get params :block)
   2997             (`nil nil)
   2998             (range
   2999              (org-clock-special-range range nil t week-start month-start))))
   3000          ;; For both START and END, any number is an absolute day
   3001          ;; number from Agenda.  Otherwise, consider value to be an Org
   3002          ;; timestamp string.  The `:block' property has precedence
   3003          ;; over `:tstart' and `:tend'.
   3004          (start
   3005           (pcase (if range (car range) (plist-get params :tstart))
   3006             ((and (pred numberp) n)
   3007              (pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
   3008                (org-encode-time 0 0 org-extend-today-until d m y)))
   3009             (timestamp
   3010 	     (seconds-to-time
   3011 	      (org-matcher-time (or timestamp
   3012 				    ;; The year Org was born.
   3013 				    "<2003-01-01 Thu 00:00>"))))))
   3014          (end
   3015           (pcase (if range (nth 1 range) (plist-get params :tend))
   3016             ((and (pred numberp) n)
   3017              (pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
   3018                (org-encode-time 0 0 org-extend-today-until d m y)))
   3019             (timestamp (seconds-to-time (org-matcher-time timestamp))))))
   3020     (while (time-less-p start end)
   3021       (unless (bolp) (insert "\n"))
   3022       ;; Insert header before each clock table.
   3023       (insert "\n"
   3024               step-header
   3025               (format-time-string (org-time-stamp-format nil t) start)
   3026 	      "\n")
   3027       ;; Compute NEXT, which is the end of the current clock table,
   3028       ;; according to step.
   3029       (let* ((next
   3030               ;; In Emacs-27 and Emacs-28 `encode-time' does not support 6 elements
   3031               ;; list argument so `org-encode-time' can not be outside of `pcase'.
   3032               (pcase-let
   3033                   ((`(,_ ,_ ,_ ,d ,m ,y ,dow . ,_) (decode-time start)))
   3034                 (pcase step
   3035                   (`day (org-encode-time 0 0 org-extend-today-until (1+ d) m y))
   3036                   (`week
   3037                    (let ((offset (if (= dow week-start) 7
   3038                                    (mod (- week-start dow) 7))))
   3039                      (org-encode-time 0 0 org-extend-today-until (+ d offset) m y)))
   3040                   (`semimonth (org-encode-time 0 0 0
   3041                                                (if (< d 16) 16 1)
   3042                                                (if (< d 16) m (1+ m)) y))
   3043                   (`month (org-encode-time 0 0 0 month-start (1+ m) y))
   3044                   (`quarter (org-encode-time 0 0 0 month-start (+ 3 m) y))
   3045                   (`year (org-encode-time 0 0 org-extend-today-until 1 1 (1+ y))))))
   3046              (table-begin (line-beginning-position 0))
   3047 	     (step-time
   3048               ;; Write clock table between START and NEXT.
   3049 	      (org-dblock-write:clocktable
   3050 	       (org-combine-plists
   3051 	        params (list :header ""
   3052                              :step nil
   3053                              :block nil
   3054 		             :tstart (format-time-string
   3055                                       (org-time-stamp-format t t)
   3056                                       start)
   3057 		             :tend (format-time-string
   3058                                     (org-time-stamp-format t t)
   3059                                     ;; Never include clocks past END.
   3060                                     (if (time-less-p end next) end next)))))))
   3061 	(let ((case-fold-search t)) (re-search-forward "^[ \t]*#\\+END:"))
   3062 	;; Remove the table if it is empty and `:stepskip0' is
   3063 	;; non-nil.
   3064 	(when (and ignore-empty-tables (equal step-time 0))
   3065 	  (delete-region (line-beginning-position) table-begin))
   3066         (setq start next))
   3067       (end-of-line 0))))
   3068 
   3069 (defun org-clock-get-table-data (file params)
   3070   "Get the clocktable data for file FILE, with parameters PARAMS.
   3071 FILE is only for identification - this function assumes that
   3072 the correct buffer is current, and that the wanted restriction is
   3073 in place.
   3074 The return value will be a list with the file name and the total
   3075 file time (in minutes) as 1st and 2nd elements.  The third element
   3076 of this list will be a list of headline entries.  Each entry has the
   3077 following structure:
   3078 
   3079   (LEVEL HEADLINE TAGS TIMESTAMP TIME PROPERTIES)
   3080 
   3081 LEVEL:      The level of the headline, as an integer.  This will be
   3082             the reduced level, so 1,2,3,... even if only odd levels
   3083             are being used.
   3084 HEADLINE:   The text of the headline.  Depending on PARAMS, this may
   3085             already be formatted like a link.
   3086 TAGS:       The list of tags of the headline.
   3087 TIMESTAMP:  If PARAMS require it, this will be a time stamp found in the
   3088             entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive,
   3089             in this sequence.
   3090 TIME:       The sum of all time spend in this tree, in minutes.  This time
   3091             will of cause be restricted to the time block and tags match
   3092             specified in PARAMS.
   3093 PROPERTIES: The list properties specified in the `:properties' parameter
   3094             along with their value, as an alist following the pattern
   3095             (NAME . VALUE)."
   3096   (let* ((maxlevel (or (plist-get params :maxlevel) 3))
   3097 	 (timestamp (plist-get params :timestamp))
   3098 	 (ts (plist-get params :tstart))
   3099 	 (te (plist-get params :tend))
   3100 	 (ws (plist-get params :wstart))
   3101 	 (ms (plist-get params :mstart))
   3102 	 (block (plist-get params :block))
   3103 	 (link (plist-get params :link))
   3104 	 (tags (plist-get params :tags))
   3105 	 (match (plist-get params :match))
   3106 	 (properties (plist-get params :properties))
   3107 	 (inherit-property-p (plist-get params :inherit-props))
   3108 	 (matcher (and match (cdr (org-make-tags-matcher match))))
   3109 	 cc st p tbl)
   3110 
   3111     (setq org-clock-file-total-minutes nil)
   3112     (when block
   3113       (setq cc (org-clock-special-range block nil t ws ms)
   3114 	    ts (car cc)
   3115 	    te (nth 1 cc)))
   3116     (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts)))
   3117     (when (integerp te) (setq te (calendar-gregorian-from-absolute te)))
   3118     (when (and ts (listp ts))
   3119       (setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts))))
   3120     (when (and te (listp te))
   3121       (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te))))
   3122     ;; Now the times are strings we can parse.
   3123     (if ts (setq ts (org-matcher-time ts)))
   3124     (if te (setq te (org-matcher-time te)))
   3125     (save-excursion
   3126       (org-clock-sum ts te
   3127 		     (when matcher
   3128 		       (lambda ()
   3129 			 (let* ((todo (org-get-todo-state))
   3130 				(tags-list (org-get-tags))
   3131 				(org-scanner-tags tags-list)
   3132 				(org-trust-scanner-tags t)
   3133                                 (level (org-current-level)))
   3134 			   (funcall matcher todo tags-list level)))))
   3135       (goto-char (point-min))
   3136       (setq st t)
   3137       (while (or (and (bobp) (prog1 st (setq st nil))
   3138 		      (get-text-property (point) :org-clock-minutes)
   3139 		      (setq p (point-min)))
   3140 		 (setq p (next-single-property-change
   3141 			  (point) :org-clock-minutes)))
   3142 	(goto-char p)
   3143 	(let ((time (get-text-property p :org-clock-minutes)))
   3144 	  (when (and time (> time 0) (org-at-heading-p))
   3145 	    (let ((level (org-reduced-level (org-current-level))))
   3146 	      (when (<= level maxlevel)
   3147 		(let* ((headline (org-get-heading t t t t))
   3148 		       (hdl
   3149 			(if (not link) headline
   3150 			  (let ((search
   3151 				 (org-link-heading-search-string headline)))
   3152 			    (org-link-make-string
   3153 			     (if (not (buffer-file-name)) search
   3154 			       (format "file:%s::%s" (buffer-file-name) search))
   3155 			     ;; Prune statistics cookies.  Replace
   3156 			     ;; links with their description, or
   3157 			     ;; a plain link if there is none.
   3158 			     (org-trim
   3159 			      (org-link-display-format
   3160 			       (replace-regexp-in-string
   3161 				"\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" ""
   3162 				headline)))))))
   3163 		       (tgs (and tags (org-get-tags)))
   3164 		       (tsp
   3165 			(and timestamp
   3166 			     (cl-some (lambda (p) (org-entry-get (point) p))
   3167 				      '("SCHEDULED" "DEADLINE" "TIMESTAMP"
   3168 					"TIMESTAMP_IA"))))
   3169 		       (props
   3170 			(and properties
   3171 			     (delq nil
   3172 				   (mapcar
   3173 				    (lambda (p)
   3174 				      (let ((v (org-entry-get
   3175 						(point) p inherit-property-p)))
   3176 					(and v (cons p v))))
   3177 				    properties)))))
   3178 		  (push (list level hdl tgs tsp time props) tbl)))))))
   3179       (list file org-clock-file-total-minutes (nreverse tbl)))))
   3180 
   3181 ;; Saving and loading the clock
   3182 
   3183 (defvar org-clock-loaded nil
   3184   "Was the clock file loaded?")
   3185 
   3186 ;;;###autoload
   3187 (defun org-clock-update-time-maybe ()
   3188   "If this is a CLOCK line, update it and return t.
   3189 Otherwise, return nil."
   3190   (interactive)
   3191   (let ((origin (point))) ;; `save-excursion' may not work when deleting.
   3192     (prog1
   3193         (save-excursion
   3194           (forward-line 0)
   3195           (skip-chars-forward " \t")
   3196           (when (looking-at org-clock-string)
   3197             (let ((re (concat "[ \t]*" org-clock-string
   3198 		              " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]"
   3199 		              "\\([ \t]*=>.*\\)?\\)?"))
   3200 	          ts te h m s neg)
   3201               (cond
   3202 	       ((not (looking-at re))
   3203 	        nil)
   3204 	       ((not (match-end 2))
   3205 	        (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
   3206 		           (> org-clock-marker (point))
   3207                            (<= org-clock-marker (line-end-position)))
   3208 	          ;; The clock is running here
   3209 	          (setq org-clock-start-time
   3210 		        (org-time-string-to-time (match-string 1)))
   3211 	          (org-clock-update-mode-line)))
   3212 	       (t
   3213                 ;; Prevent recursive call from `org-timestamp-change'.
   3214                 (cl-letf (((symbol-function 'org-clock-update-time-maybe) #'ignore))
   3215                   ;; Update timestamps.
   3216                   (save-excursion
   3217                     (goto-char (match-beginning 1)) ; opening timestamp
   3218                     (save-match-data (org-timestamp-change 0 'day)))
   3219                   ;; Refresh match data.
   3220                   (looking-at re)
   3221                   (save-excursion
   3222                     (goto-char (match-beginning 3)) ; closing timestamp
   3223                     (save-match-data (org-timestamp-change 0 'day))))
   3224                 ;; Refresh match data.
   3225                 (looking-at re)
   3226                 (and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
   3227                 (end-of-line 1)
   3228                 (setq ts (match-string 1)
   3229                       te (match-string 3))
   3230                 (setq s (- (org-time-string-to-seconds te)
   3231 		           (org-time-string-to-seconds ts))
   3232                       neg (< s 0)
   3233                       s (abs s)
   3234                       h (floor (/ s 3600))
   3235                       s (- s (* 3600 h))
   3236                       m (floor (/ s 60))
   3237                       s (- s (* 60 s)))
   3238 	        (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
   3239 	        t)))))
   3240       ;; Move back to initial position, but never beyond updated
   3241       ;; clock.
   3242       (unless (< (point) origin)
   3243         (goto-char origin)))))
   3244 
   3245 (defun org-clock-save ()
   3246   "Persist various clock-related data to disk.
   3247 The details of what will be saved are regulated by the variable
   3248 `org-clock-persist'."
   3249   (when (and org-clock-persist
   3250              (or org-clock-loaded
   3251 		 org-clock-has-been-used
   3252 		 (not (file-exists-p org-clock-persist-file))))
   3253     (with-temp-file org-clock-persist-file
   3254       (insert (format ";; %s - %s at %s\n"
   3255 		      (file-name-nondirectory org-clock-persist-file)
   3256 		      (system-name)
   3257 		      (format-time-string (org-time-stamp-format t))))
   3258       ;; Store clock to be resumed.
   3259       (when (and (memq org-clock-persist '(t clock))
   3260 		 (let ((b (org-base-buffer (org-clocking-buffer))))
   3261 		   (and (buffer-live-p b)
   3262 			(buffer-file-name b)
   3263 			(or (not org-clock-persist-query-save)
   3264                             (y-or-n-p (format "Save current clock (%s)?"
   3265 					      org-clock-heading))))))
   3266 	(insert
   3267 	 (format "(setq org-clock-stored-resume-clock '(%S . %d))\n"
   3268 		 (buffer-file-name (org-base-buffer (org-clocking-buffer)))
   3269 		 (marker-position org-clock-marker))))
   3270       ;; Store clocked task history.  Tasks are stored reversed to
   3271       ;; make reading simpler.
   3272       (when (and (memq org-clock-persist '(t history))
   3273 		 org-clock-history)
   3274 	(insert
   3275 	 (format "(setq org-clock-stored-history '(%s))\n"
   3276 		 (mapconcat
   3277 		  (lambda (m)
   3278 		    (let ((b (org-base-buffer (marker-buffer m))))
   3279 		      (when (and (buffer-live-p b)
   3280 				 (buffer-file-name b))
   3281 			(format "(%S . %d)"
   3282 				(buffer-file-name b)
   3283 				(marker-position m)))))
   3284 		  (reverse org-clock-history)
   3285 		  " ")))))))
   3286 
   3287 (defun org-clock-load ()
   3288   "Load clock-related data from disk, maybe resuming a stored clock."
   3289   (when (and org-clock-persist (not org-clock-loaded))
   3290     (if (not (file-readable-p org-clock-persist-file))
   3291 	(message "Not restoring clock data; %S not found" org-clock-persist-file)
   3292       (message "Restoring clock data")
   3293       ;; Load history.
   3294       (load-file org-clock-persist-file)
   3295       (setq org-clock-loaded t)
   3296       (pcase-dolist (`(,(and file (pred file-exists-p)) . ,position)
   3297 		     org-clock-stored-history)
   3298 	(org-clock-history-push position (find-file-noselect file)))
   3299       ;; Resume clock.
   3300       (pcase org-clock-stored-resume-clock
   3301 	(`(,(and file (pred file-exists-p)) . ,position)
   3302 	 (with-current-buffer (find-file-noselect file)
   3303 	   (when (or (not org-clock-persist-query-resume)
   3304                      (y-or-n-p (format "Resume clock (%s)?"
   3305 				       (save-excursion
   3306 					 (goto-char position)
   3307 					 (org-get-heading t t)))))
   3308 	     (goto-char position)
   3309 	     (let ((org-clock-in-resume 'auto-restart)
   3310 		   (org-clock-auto-clock-resolution nil))
   3311 	       (org-clock-in)
   3312 	       (when (org-invisible-p) (org-fold-show-context))))))
   3313 	(_ nil)))))
   3314 
   3315 (defun org-clock-kill-emacs-query ()
   3316   "Query user when killing Emacs.
   3317 This function is added to `kill-emacs-query-functions'."
   3318   (let ((buf (org-clocking-buffer)))
   3319     (when (and buf (yes-or-no-p "Clock out and save? "))
   3320       (with-current-buffer buf
   3321         (org-clock-out)
   3322         (save-buffer))))
   3323   ;; Unconditionally return t for `kill-emacs-query-functions'.
   3324   t)
   3325 
   3326 ;; Suggested bindings
   3327 (org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate)
   3328 
   3329 (provide 'org-clock)
   3330 
   3331 ;; Local variables:
   3332 ;; generated-autoload-file: "org-loaddefs.el"
   3333 ;; coding: utf-8
   3334 ;; End:
   3335 
   3336 ;;; org-clock.el ends here