dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

org-clock.el (120799B)


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