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