Mercurial > emacs
comparison lisp/org/org-clock.el @ 94414:d86cb59eea9f
2008-04-27 Carsten Dominik <dominik@science.uva.nl>
* org/org.el (org-html-level-start): Always have id's in HTML
(org-export-as-html): Use `org-link-protocols' to
retrieve the export form of the link.
(org-add-link-type): Final parameter renamed from PUBLISH. Better
documentation of how it is to be used. Avoid double entries for
the same link type.
(org-add-link-props): New function.
(org-modules-loaded): New variable.
(org-load-modules-maybe, org-set-modules): New function.
(org-modules): New option.
(org-mode, org-cycle, orgstruct-mode, org-run-like-in-org-mode)
(orgtbl-mode, org-store-link, org-insert-link-global)
(org-open-at-point): Call `org-load-modules-maybe'.
(org-search-view): Add more text properties.
(org-agenda-schedule, org-agenda-deadline): Allow also in
search-type agendas.
(org-search-view): Order of arguments has been changed.
Interpret prefix-arg as TODO-ONLY.
(org-agenda, org-run-agenda-series, org-agenda-manipulate-query):
Take new argument order of `org-search-view' into account.
(org-todo-only): New variable.
(org-search-syntax-table): New variable and function.
(org-search-view): Do the search with the special syntax table.
(define-obsolete-function-alias): Make work with XEmacs.
(org-add-planning-info): Use old date as default when modifying an
existing deadline or scheduled item.
(org-agenda-compute-time-span): Make argument N optional.
(org-agenda-format-date-aligned): Require `cal-iso'.
(org-agenda-list): Include week into into agenda heading, don't
list it at each date (only on Mondays).
(org-read-date-analyze): Define local variable `iso-date'.
(org-agenda-format-date-aligned): Remove dependency on
`calendar-time-from-absolute'.
(org-remember-apply-template, org-go-to-remember-target):
Interpret filenames relative to `org-directory'.
(org-complete): Silently fail when trying to complete
keywords that don't have a default value.
(org-get-current-options): Added a #+DATE: option.
(org-additional-option-like-keywords): Removed "DATE:" from the
list of additional keywords.
(org-export-as-html): Removed (current-time) as unnecessary second
argument of `format-time-string'.
(org-clock-find-position): Handle special case at end of
buffer.
(org-agenda-day-view): New argument DAY-OF-YEAR, pass it on to
`org-agenda-change-time-span'.
(org-agenda-week-view): New argument ISO-WEEK, pass it on to
`org-agenda-change-time-span'.
(org-agenda-month-view): New argument MONTH, pass it on to
`org-agenda-change-time-span'.
(org-agenda-year-view): New argument YEAR, pass it on to
`org-agenda-change-time-span'.
(org-agenda-change-time-span): New optional argument N, pass it on
to `org-agenda-compute-time-span'.
(org-agenda-compute-time-span): New argument N, interpret it by
changing the starting day.
(org-small-year-to-year): New function.
(org-scheduled-past-days): Respect
`org-scheduled-past-days'.
(org-auto-repeat-maybe): Make sure that repeating
dates are pushed into the future, and that the shift is at least
one interval, never 0.
(org-update-checkbox-count): Fix bug with checkbox
counting.
(org-add-note): New command.
(org-add-log-setup): Renamed from `org-add-log-maybe'.
(org-log-note-headings): New entry for plain notes (i.e. notes not
related to state changes or clocking).
(org-get-org-file): Check for availability of
`remember-data-file'.
(org-cached-entry-get): Allow a regexp value for
`org-use-property-inheritance'.
(org-use-property-inheritance): Allow regexp value. Fix bug in
customization type.
(org-use-tag-inheritance): Allow a list and a regexp value for
this variable.
(org-scan-tags, org-get-tags-at): Implement selective tag
inheritance.
(org-entry-get): Respect value `selective' for the INHERIT
argument.
(org-tag-inherit-p, org-property-inherit-p): New functions.
(org-agenda-format-date-aligned): Allow 10 characters for
weekday, to acomodate German locale.
(org-add-archive-files): New function.
(org-agenda-files): New argument `ext', to
get archive files as well.
(org-tbl-menu): Protect the use of variables that
are only available when org-table.el gets loaded.
(org-read-agenda-file-list): Error if `org-agenda-files' is a
single directory.
(org-open-file): Allow a batch process to trigger
waiting after executing a system command.
(org-store-link): Link to headline when there is not
target and no region in an org-mode buffer when creating a link.
(org-link-types-re): New variable.
(org-make-link-regexps): Compute `org-link-types-re'.
(org-make-link-description-function): New option.
(org-agenda-date, org-agenda-date-weekend): New faces.
(org-archive-sibling-heading): New option.
(org-archive-to-archive-sibling): New function.
(org-iswitchb): New command.
(org-buffer-list): New function.
(org-agenda-columns): Also try the #+COLUMNS line in
the buffer associated with the entry at point (or with the first
entry in the agenda view).
(org-modules): Add entry for org-bibtex.el.
(org-completion-fallback-command): Moved into `org-completion'
group.
(org-clock-heading-function): Moved to `org-progress' group.
(org-auto-repeat-maybe): Make sure that a note can
be enforces if `org-log-repeat' is `note'.
(org-modules): Allow additional symbols for external
packages.
(org-ctrl-c-ctrl-c): Allow for `org-clock-overlays' to be
undefined.
(org-clock-goto): Hide drawers after showing an
entry with `org-clock-goto.'
(org-shiftup, org-shiftdown, org-shiftright, org-shiftleft): Try
also a clocktable block shift.
(org-clocktable-try-shift): New function.
(org-columns-hscoll-title): New function.
(org-columns-previous-hscroll): New variable.
(org-columns-full-header-line-format): New variable.
(org-columns-display-here-title, org-columns-remove-overlays):
Install `org-columns-hscoll-title' in post-command-hook.
* org/org.el: Split into many small files.
* org/org-agenda.el: New file, split off from org.el.
* org/org-archive.el: New file, split off from org.el.
* org/org-bbdb.el: New file.
* org/org-bibtex.el: New file, split off from org.el.
* org/org-clock.el: New file, split off from org.el.
* org/org-colview.el: New file, split off from org.el.
* org/org-compat.el: New file, split off from org.el.
* org/org-exp.el: New file, split off from org.el.
* org/org-faces.el: New file, split off from org.el.
* org/org-gnus.el: New file, split off from org.el.
* org/org-info.el: New file, split off from org.el.
* org/org-infojs.el: New file.
* org/org-irc.el: New file.
* org/org-macs.el: New file, split off from org.el.
* org/org-mew.el: New file.
* org/org-mhe.el: New file, split off from org.el.
* org/org-publish.el: New file, split off from org.el.
* org/org-remember.el: New file, split off from org.el.
* org/org-rmail.el: New file, split off from org.el.
* org/org-table.el: New file, split off from org.el.
* org/org-vm.el: New file, split off from org.el.
* org/org-wl.el: New file, split off from org.el.
2008-04-27 Jason Riedy <jason@acm.org>
* lisp/org-table.el (orgtbl-to-generic): Add a :remove-nil-lines
parameter that supresses lines that evaluate to NIL.
(orgtbl-get-fmt): New inline function for
picking apart formats that may be lists.
(orgtbl-apply-fmt): New inline function for applying formats that
may be functions.
(orgtbl-eval-str): New inline function for strings that may be
functions.
(orgtbl-format-line, orgtbl-to-generic): Use and document.
(orgtbl-to-latex, orgtbl-to-texinfo): Document.
(*orgtbl-llfmt*, *orgtbl-llstart*)
(*orgtbl-llend*): Dynamic variables for last-line formatting.
(orgtbl-format-section): Shift formatting to support detecting the
last line and formatting it specially.
(orgtbl-to-generic): Document :ll* formats. Set to the non-ll
formats unless overridden.
(orgtbl-to-latex): Suggest using :llend to suppress the final \\.
(*orgtbl-table*, *orgtbl-rtn*): Dynamically
bound variables to hold the input collection of lines and output
formatted text.
(*orgtbl-hline*, *orgtbl-sep*, *orgtbl-fmt*, *orgtbl-efmt*,
(*orgtbl-lfmt*, *orgtbl-lstart*, *orgtbl-lend*): Dynamically bound
format parameters.
(orgtbl-format-line): New function encapsulating formatting for a
single line.
(orgtbl-format-section): Similar for each section. Rebinding the
dynamic vars customizes the formatting for each section.
(orgtbl-to-generic): Use orgtbl-format-line and
orgtbl-format-section.
(org-get-param): Now unused, so delete.
(orgtbl-gather-send-defs): New function to
gather all the SEND definitions before a table.
(orgtbl-send-replace-tbl): New function to find the RECEIVE
corresponding to the current name.
(orgtbl-send-table): Use the previous two functions and implement
multiple destinations for each table.
* doc/org.texi (A LaTeX example): Note that fmt may be a
one-argument function, and efmt may be a two-argument function.
(Radio tables): Document multiple destinations.
2008-04-27 Carsten Dominik <dominik@science.uva.nl>
* org/org-agenda.el (org-add-to-diary-list): New function.
(org-prefix-has-effort): New variable.
(org-sort-agenda-noeffort-is-high): New option.
(org-agenda-columns-show-summaries)
(org-agenda-columns-compute-summary-properties): New options.
(org-format-agenda-item): Compute the duration of the item.
(org-agenda-weekend-days): New variable.
(org-agenda-list, org-timeline): Use the proper faces for dates in
the agenda and timeline buffers.
(org-agenda-archive-to-archive-sibling): New command.
(org-agenda-start-with-clockreport-mode): New option.
(org-agenda-clockreport-parameter-plist): New option.
(org-agenda-clocktable-mode): New variable.
(org-agenda-deadline-leaders): Allow a function value for the
deadline leader.
(org-agenda-get-deadlines): Deal with new function value.
* lisp/org-clock.el (org-clock): New customization group.
(org-clock-into-drawer, org-clock-out-when-done)
(org-clock-in-switch-to-state, org-clock-heading-function): Moved
into the new group.
(org-clock-out-remove-zero-time-clocks): New option.
(org-clock-out): Use `org-clock-out-remove-zero-time-clocks'.
(org-dblock-write:clocktable): Allow a Lisp form for the scope
parameter.
(org-dblock-write:clocktable): Fixed bug with total time
calculation.
(org-dblock-write:clocktable): Request the unrestricted list of
files.
(org-get-clocktable): New function.
(org-dblock-write:clocktable): Make sure :tstart and :tend can not
only be strings but also integers (an absolute day number) and
lists (m d y).
* org/org-colview.el (org-columns-next-allowed-value)
(org-columns-edit-value): Limit the effort for updatig in the
agenda to recomputing a single file.
(org-columns-compute): Only write property value if it has
changed. This avoids raising the buffer-change-flag
unnecessarily.
(org-agenda-colview-summarize)
(org-agenda-colview-compute): New functions.
(org-agenda-columns): Call `org-agenda-colview-summarize'.
* org/org-exp.el (org-export-run-in-background): New option.
(org-export-icalendar): Allow a batch process to trigger waiting
after executing a system command.
(org-export-preprocess-string): Renamed-from
`org-cleaned-string-for-export'.
(org-export-html-style): Made target class look like normal text.
(org-export-as-html): Make use of the better proprocessing in
`org-cleaned-string-for-export'.
(org-cleaned-string-for-export): Better treatment of heuristic
targets, many more internal links will now work in HTML export.
(org-get-current-options): Incorporate LINK_UP, LINK_HOME, and
INFOJS.
(org-export-inbuffer-options-extra): New variable.
(org-export-options-filters): New hook.
(org-infile-export-plist): Find also the settings keywords in
`org-export-inbuffer-options-extra'.
(org-infile-export-plist): Allow multiple #+OPTIONS lines and
multiple #+INFOJS_OPT lines.
(org-export-html-handle-js-options): New function.
(org-export-html-infojs-setup): New option.
(org-export-as-html): Call `org-export-html-handle-js-options'.
Add autoload to all entry points.
(org-skip-comments): Function removed.
* org/org-table.el (org-table-make-reference): Extra parenthesis
around single fields, to make sure that algebraic formulas get
correctly interpreted by calc.
(org-table-current-column): No longer interactive.
* org/org-export-latex.el (org-export-latex-preprocess): Renamed
from `org-export-latex-cleaned-string'.
2008-04-27 Bastien Guerry <bzg@altern.org>
* org/org-publish.el (org-publish-get-base-files-1): New function.
(org-publish-get-base-files): Use it.
(org-publish-temp-files): New variable.
Don't require 'dired-aux anymore.
(org-publish-initial-buffer): New variable.
(org-publish-org-to, org-publish): Use it.
(org-publish-get-base-files-1): Bug fix: get
the proper list of files when recursing thru a directory.
(org-publish-get-base-files): Use the :exclude property to skip
both files and directories.
| author | Carsten Dominik <dominik@science.uva.nl> |
|---|---|
| date | Sun, 27 Apr 2008 18:33:39 +0000 |
| parents | |
| children | da5141d2e8fc |
comparison
equal
deleted
inserted
replaced
| 94413:90289baecd6a | 94414:d86cb59eea9f |
|---|---|
| 1 ;;; org-clock.el --- The time clocking code for Org-mode | |
| 2 | |
| 3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
| 6 ;; Keywords: outlines, hypermedia, calendar, wp | |
| 7 ;; Homepage: http://orgmode.org | |
| 8 ;; Version: 6.02b | |
| 9 ;; | |
| 10 ;; This file is part of GNU Emacs. | |
| 11 ;; | |
| 12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 13 ;; it under the terms of the GNU General Public License as published by | |
| 14 ;; the Free Software Foundation; either version 3, or (at your option) | |
| 15 ;; any later version. | |
| 16 | |
| 17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 20 ;; GNU General Public License for more details. | |
| 21 | |
| 22 ;; You should have received a copy of the GNU General Public License | |
| 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
| 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
| 25 ;; Boston, MA 02110-1301, USA. | |
| 26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 27 ;; | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This file contains the time clocking code for Org-mode | |
| 31 | |
| 32 (require 'org) | |
| 33 (eval-when-compile | |
| 34 (require 'cl) | |
| 35 (require 'calendar)) | |
| 36 | |
| 37 (declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) | |
| 38 | |
| 39 (defgroup org-clock nil | |
| 40 "Options concerning clocking working time in Org-mode." | |
| 41 :tag "Org Clock" | |
| 42 :group 'org-progress) | |
| 43 | |
| 44 (defcustom org-clock-into-drawer 2 | |
| 45 "Should clocking info be wrapped into a drawer? | |
| 46 When t, clocking info will always be inserted into a :CLOCK: drawer. | |
| 47 If necessary, the drawer will be created. | |
| 48 When nil, the drawer will not be created, but used when present. | |
| 49 When an integer and the number of clocking entries in an item | |
| 50 reaches or exceeds this number, a drawer will be created." | |
| 51 :group 'org-todo | |
| 52 :group 'org-clock | |
| 53 :type '(choice | |
| 54 (const :tag "Always" t) | |
| 55 (const :tag "Only when drawer exists" nil) | |
| 56 (integer :tag "When at least N clock entries"))) | |
| 57 | |
| 58 (defcustom org-clock-out-when-done t | |
| 59 "When t, the clock will be stopped when the relevant entry is marked DONE. | |
| 60 Nil means, clock will keep running until stopped explicitly with | |
| 61 `C-c C-x C-o', or until the clock is started in a different item." | |
| 62 :group 'org-clock | |
| 63 :type 'boolean) | |
| 64 | |
| 65 (defcustom org-clock-out-remove-zero-time-clocks nil | |
| 66 "Non-nil means, remove the clock line when the resulting time is zero." | |
| 67 :group 'org-clock | |
| 68 :type 'boolean) | |
| 69 | |
| 70 (defcustom org-clock-in-switch-to-state nil | |
| 71 "Set task to a special todo state while clocking it. | |
| 72 The value should be the state to which the entry should be switched." | |
| 73 :group 'org-clock | |
| 74 :group 'org-todo | |
| 75 :type '(choice | |
| 76 (const :tag "Don't force a state" nil) | |
| 77 (string :tag "State"))) | |
| 78 | |
| 79 (defcustom org-clock-history-length 5 | |
| 80 "Number of clock tasks to remember in history." | |
| 81 :group 'org-clock | |
| 82 :type 'integer) | |
| 83 | |
| 84 (defcustom org-clock-heading-function nil | |
| 85 "When non-nil, should be a function to create `org-clock-heading'. | |
| 86 This is the string shown in the mode line when a clock is running. | |
| 87 The function is called with point at the beginning of the headline." | |
| 88 :group 'org-clock | |
| 89 :type 'function) | |
| 90 | |
| 91 | |
| 92 ;;; The clock for measuring work time. | |
| 93 | |
| 94 (defvar org-mode-line-string "") | |
| 95 (put 'org-mode-line-string 'risky-local-variable t) | |
| 96 | |
| 97 (defvar org-mode-line-timer nil) | |
| 98 (defvar org-clock-heading "") | |
| 99 (defvar org-clock-start-time "") | |
| 100 | |
| 101 (defvar org-clock-history nil | |
| 102 "Marker pointing to the previous task teking clock time. | |
| 103 This is used to find back to the previous task after interrupting work. | |
| 104 When clocking into a task and the clock is currently running, this marker | |
| 105 is moved to the position of the currently running task and continues | |
| 106 to point there even after the task is clocked out.") | |
| 107 | |
| 108 (defvar org-clock-default-task (make-marker) | |
| 109 "Marker pointing to the default task that should clock time. | |
| 110 The clock can be made to switch to this task after clocking out | |
| 111 of a different task.") | |
| 112 | |
| 113 (defvar org-clock-interrupted-task (make-marker) | |
| 114 "Marker pointing to the default task that should clock time. | |
| 115 The clock can be made to switch to this task after clocking out | |
| 116 of a different task.") | |
| 117 | |
| 118 (defun org-clock-history-push (&optional pos buffer) | |
| 119 "Push a marker to the clock history." | |
| 120 (let ((m (move-marker (make-marker) (or pos (point)) buffer)) n l) | |
| 121 (while (setq n (member m org-clock-history)) | |
| 122 (move-marker (car n) nil)) | |
| 123 (setq org-clock-history | |
| 124 (delq nil | |
| 125 (mapcar (lambda (x) (if (marker-buffer x) x nil)) | |
| 126 org-clock-history))) | |
| 127 (when (>= (setq l (length org-clock-history)) org-clock-history-length) | |
| 128 (setq org-clock-history | |
| 129 (nreverse | |
| 130 (nthcdr (- l org-clock-history-length -1) | |
| 131 (nreverse org-clock-history))))) | |
| 132 (push m org-clock-history))) | |
| 133 | |
| 134 (defun org-clock-select-task (&optional prompt) | |
| 135 "Select a task that recently was associated with clocking." | |
| 136 (interactive) | |
| 137 (let (sel-list rpl file task (i 0) s) | |
| 138 (save-window-excursion | |
| 139 (org-switch-to-buffer-other-window | |
| 140 (get-buffer-create "*Clock Task Select*")) | |
| 141 (erase-buffer) | |
| 142 (when (marker-buffer org-clock-default-task) | |
| 143 (insert (org-add-props "Default Task\n" nil 'face 'bold)) | |
| 144 (setq s (org-clock-insert-selection-line ?d org-clock-default-task)) | |
| 145 (push s sel-list)) | |
| 146 (when (marker-buffer org-clock-interrupted-task) | |
| 147 (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold)) | |
| 148 (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task)) | |
| 149 (push s sel-list)) | |
| 150 (when (marker-buffer org-clock-marker) | |
| 151 (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold)) | |
| 152 (setq s (org-clock-insert-selection-line ?c org-clock-marker)) | |
| 153 (push s sel-list)) | |
| 154 (insert (org-add-props "Recent Tasks\n" nil 'face 'bold)) | |
| 155 (mapc | |
| 156 (lambda (m) | |
| 157 (when (marker-buffer m) | |
| 158 (setq i (1+ i) | |
| 159 s (org-clock-insert-selection-line | |
| 160 (string-to-char (number-to-string i)) m)) | |
| 161 (push s sel-list))) | |
| 162 org-clock-history) | |
| 163 (shrink-window-if-larger-than-buffer) | |
| 164 (message (or prompt "Select task for clocking:")) | |
| 165 (setq rpl (read-char-exclusive)) | |
| 166 (cond | |
| 167 ((eq rpl ?q) nil) | |
| 168 ((eq rpl ?x) nil) | |
| 169 ((assoc rpl sel-list) (cdr (assoc rpl sel-list))) | |
| 170 (t (error "Invalid task choice %c" rpl)))))) | |
| 171 | |
| 172 (defun org-clock-insert-selection-line (i marker) | |
| 173 (when (marker-buffer marker) | |
| 174 (let (file cat task) | |
| 175 (with-current-buffer (marker-buffer marker) | |
| 176 (save-excursion | |
| 177 (goto-char marker) | |
| 178 (setq file (buffer-file-name (marker-buffer marker)) | |
| 179 cat (or (org-get-category) | |
| 180 (progn (org-refresh-category-properties) | |
| 181 (org-get-category))) | |
| 182 task (org-get-heading 'notags)))) | |
| 183 (when (and cat task) | |
| 184 (insert (format "[%c] %-15s %s\n" i cat task)) | |
| 185 (cons i marker))))) | |
| 186 | |
| 187 (defun org-update-mode-line () | |
| 188 (let* ((delta (- (time-to-seconds (current-time)) | |
| 189 (time-to-seconds org-clock-start-time))) | |
| 190 (h (floor delta 3600)) | |
| 191 (m (floor (- delta (* 3600 h)) 60))) | |
| 192 (setq org-mode-line-string | |
| 193 (propertize (format "-[%d:%02d (%s)]" h m org-clock-heading) | |
| 194 'help-echo "Org-mode clock is running")) | |
| 195 (force-mode-line-update))) | |
| 196 | |
| 197 (defvar org-clock-mode-line-entry nil | |
| 198 "Information for the modeline about the running clock.") | |
| 199 | |
| 200 (defun org-clock-in (&optional select) | |
| 201 "Start the clock on the current item. | |
| 202 If necessary, clock-out of the currently active clock. | |
| 203 With prefix arg SELECT, offer a list of recently clocked ta sks to | |
| 204 clock into. When SELECT is `C-u C-u', clock into the current task and mark | |
| 205 is as the default task, a special task that will always be offered in | |
| 206 the clocking selection, associated with the letter `d'." | |
| 207 (interactive "P") | |
| 208 (let ((interrupting (marker-buffer org-clock-marker)) | |
| 209 ts selected-task) | |
| 210 (when (equal select '(4)) | |
| 211 (setq selected-task (org-clock-select-task "Clock-in on task: ")) | |
| 212 (if selected-task | |
| 213 (setq selected-task (copy-marker selected-task)) | |
| 214 (error "Abort"))) | |
| 215 ;; Are we interrupting the clocking of a differnt task? | |
| 216 (if interrupting | |
| 217 (progn | |
| 218 (move-marker org-clock-interrupted-task | |
| 219 (marker-position org-clock-marker) | |
| 220 (marker-buffer org-clock-marker)) | |
| 221 (org-clock-out t))) | |
| 222 | |
| 223 (when (equal select '(16)) | |
| 224 (save-excursion | |
| 225 (org-back-to-heading t) | |
| 226 (move-marker org-clock-default-task (point)))) | |
| 227 | |
| 228 (save-excursion | |
| 229 (org-back-to-heading t) | |
| 230 (when (and selected-task (marker-buffer selected-task)) | |
| 231 (set-buffer (marker-buffer selected-task)) | |
| 232 (goto-char selected-task) | |
| 233 (move-marker selected-task nil)) | |
| 234 (or interrupting (move-marker org-clock-interrupted-task nil)) | |
| 235 (org-clock-history-push) | |
| 236 (when (and org-clock-in-switch-to-state | |
| 237 (not (looking-at (concat outline-regexp "[ \t]*" | |
| 238 org-clock-in-switch-to-state | |
| 239 "\\>")))) | |
| 240 (org-todo org-clock-in-switch-to-state)) | |
| 241 (if (and org-clock-heading-function | |
| 242 (functionp org-clock-heading-function)) | |
| 243 (setq org-clock-heading (funcall org-clock-heading-function)) | |
| 244 (if (looking-at org-complex-heading-regexp) | |
| 245 (setq org-clock-heading (match-string 4)) | |
| 246 (setq org-clock-heading "???"))) | |
| 247 (setq org-clock-heading (propertize org-clock-heading 'face nil)) | |
| 248 (org-clock-find-position) | |
| 249 | |
| 250 (insert "\n") (backward-char 1) | |
| 251 (indent-relative) | |
| 252 (insert org-clock-string " ") | |
| 253 (setq org-clock-start-time (current-time)) | |
| 254 (setq ts (org-insert-time-stamp (current-time) 'with-hm 'inactive)) | |
| 255 (move-marker org-clock-marker (point) (buffer-base-buffer)) | |
| 256 (or global-mode-string (setq global-mode-string '(""))) | |
| 257 (or (memq 'org-mode-line-string global-mode-string) | |
| 258 (setq global-mode-string | |
| 259 (append global-mode-string '(org-mode-line-string)))) | |
| 260 (org-update-mode-line) | |
| 261 (setq org-mode-line-timer (run-with-timer 60 60 'org-update-mode-line)) | |
| 262 (message "Clock started at %s" ts)))) | |
| 263 | |
| 264 (defun org-clock-find-position () | |
| 265 "Find the location where the next clock line should be inserted." | |
| 266 (org-back-to-heading t) | |
| 267 (catch 'exit | |
| 268 (let ((beg (save-excursion | |
| 269 (beginning-of-line 2) | |
| 270 (or (bolp) (newline)) | |
| 271 (point))) | |
| 272 (end (progn (outline-next-heading) (point))) | |
| 273 (re (concat "^[ \t]*" org-clock-string)) | |
| 274 (cnt 0) | |
| 275 first last) | |
| 276 (goto-char beg) | |
| 277 (when (eobp) (newline) (setq end (max (point) end))) | |
| 278 (when (re-search-forward "^[ \t]*:CLOCK:" end t) | |
| 279 ;; we seem to have a CLOCK drawer, so go there. | |
| 280 (beginning-of-line 2) | |
| 281 (throw 'exit t)) | |
| 282 ;; Lets count the CLOCK lines | |
| 283 (goto-char beg) | |
| 284 (while (re-search-forward re end t) | |
| 285 (setq first (or first (match-beginning 0)) | |
| 286 last (match-beginning 0) | |
| 287 cnt (1+ cnt))) | |
| 288 (when (and (integerp org-clock-into-drawer) | |
| 289 (>= (1+ cnt) org-clock-into-drawer)) | |
| 290 ;; Wrap current entries into a new drawer | |
| 291 (goto-char last) | |
| 292 (beginning-of-line 2) | |
| 293 (if (org-at-item-p) (org-end-of-item)) | |
| 294 (insert ":END:\n") | |
| 295 (beginning-of-line 0) | |
| 296 (org-indent-line-function) | |
| 297 (goto-char first) | |
| 298 (insert ":CLOCK:\n") | |
| 299 (beginning-of-line 0) | |
| 300 (org-indent-line-function) | |
| 301 (org-flag-drawer t) | |
| 302 (beginning-of-line 2) | |
| 303 (throw 'exit nil)) | |
| 304 | |
| 305 (goto-char beg) | |
| 306 (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) | |
| 307 (not (equal (match-string 1) org-clock-string))) | |
| 308 ;; Planning info, skip to after it | |
| 309 (beginning-of-line 2) | |
| 310 (or (bolp) (newline))) | |
| 311 (when (eq t org-clock-into-drawer) | |
| 312 (insert ":CLOCK:\n:END:\n") | |
| 313 (beginning-of-line -1) | |
| 314 (org-indent-line-function) | |
| 315 (org-flag-drawer t) | |
| 316 (beginning-of-line 2) | |
| 317 (org-indent-line-function))))) | |
| 318 | |
| 319 (defun org-clock-out (&optional fail-quietly) | |
| 320 "Stop the currently running clock. | |
| 321 If there is no running clock, throw an error, unless FAIL-QUIETLY is set." | |
| 322 (interactive) | |
| 323 (catch 'exit | |
| 324 (if (not (marker-buffer org-clock-marker)) | |
| 325 (if fail-quietly (throw 'exit t) (error "No active clock"))) | |
| 326 (let (ts te s h m remove) | |
| 327 (save-excursion | |
| 328 (set-buffer (marker-buffer org-clock-marker)) | |
| 329 (save-restriction | |
| 330 (widen) | |
| 331 (goto-char org-clock-marker) | |
| 332 (beginning-of-line 1) | |
| 333 (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) | |
| 334 (equal (match-string 1) org-clock-string)) | |
| 335 (setq ts (match-string 2)) | |
| 336 (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) | |
| 337 (goto-char (match-end 0)) | |
| 338 (delete-region (point) (point-at-eol)) | |
| 339 (insert "--") | |
| 340 (setq te (org-insert-time-stamp (current-time) 'with-hm 'inactive)) | |
| 341 (setq s (- (time-to-seconds (apply 'encode-time (org-parse-time-string te))) | |
| 342 (time-to-seconds (apply 'encode-time (org-parse-time-string ts)))) | |
| 343 h (floor (/ s 3600)) | |
| 344 s (- s (* 3600 h)) | |
| 345 m (floor (/ s 60)) | |
| 346 s (- s (* 60 s))) | |
| 347 (insert " => " (format "%2d:%02d" h m)) | |
| 348 (when (setq remove (and org-clock-out-remove-zero-time-clocks | |
| 349 (= (+ h m) 0))) | |
| 350 (beginning-of-line 1) | |
| 351 (delete-region (point) (point-at-eol)) | |
| 352 (and (looking-at "\n") (> (point-max) (1+ (point))) | |
| 353 (delete-char 1))) | |
| 354 (move-marker org-clock-marker nil) | |
| 355 (when org-log-note-clock-out | |
| 356 (org-add-log-setup 'clock-out)) | |
| 357 (when org-mode-line-timer | |
| 358 (cancel-timer org-mode-line-timer) | |
| 359 (setq org-mode-line-timer nil)) | |
| 360 (setq global-mode-string | |
| 361 (delq 'org-mode-line-string global-mode-string)) | |
| 362 (force-mode-line-update) | |
| 363 (message "Clock stopped at %s after HH:MM = %d:%02d%s" te h m | |
| 364 (if remove " => LINE REMOVED" ""))))))) | |
| 365 | |
| 366 (defun org-clock-cancel () | |
| 367 "Cancel the running clock be removing the start timestamp." | |
| 368 (interactive) | |
| 369 (if (not (marker-buffer org-clock-marker)) | |
| 370 (error "No active clock")) | |
| 371 (save-excursion | |
| 372 (set-buffer (marker-buffer org-clock-marker)) | |
| 373 (goto-char org-clock-marker) | |
| 374 (delete-region (1- (point-at-bol)) (point-at-eol))) | |
| 375 (setq global-mode-string | |
| 376 (delq 'org-mode-line-string global-mode-string)) | |
| 377 (force-mode-line-update) | |
| 378 (message "Clock canceled")) | |
| 379 | |
| 380 (defun org-clock-goto (&optional select) | |
| 381 "Go to the currently clocked-in entry. | |
| 382 With prefix arg SELECT, offer recently clocked tasks." | |
| 383 (interactive "P") | |
| 384 (let ((m (if select | |
| 385 (org-clock-select-task "Select task to go to: ") | |
| 386 org-clock-marker))) | |
| 387 (if (not (marker-buffer m)) | |
| 388 (if select | |
| 389 (error "No task selected") | |
| 390 (error "No active clock"))) | |
| 391 (switch-to-buffer (marker-buffer m)) | |
| 392 (goto-char m) | |
| 393 (org-show-entry) | |
| 394 (org-back-to-heading) | |
| 395 (org-cycle-hide-drawers 'children) | |
| 396 (recenter))) | |
| 397 | |
| 398 (defvar org-clock-file-total-minutes nil | |
| 399 "Holds the file total time in minutes, after a call to `org-clock-sum'.") | |
| 400 (make-variable-buffer-local 'org-clock-file-total-minutes) | |
| 401 | |
| 402 (defun org-clock-sum (&optional tstart tend) | |
| 403 "Sum the times for each subtree. | |
| 404 Puts the resulting times in minutes as a text property on each headline." | |
| 405 (interactive) | |
| 406 (let* ((bmp (buffer-modified-p)) | |
| 407 (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" | |
| 408 org-clock-string | |
| 409 "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) | |
| 410 (lmax 30) | |
| 411 (ltimes (make-vector lmax 0)) | |
| 412 (t1 0) | |
| 413 (level 0) | |
| 414 ts te dt | |
| 415 time) | |
| 416 (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) | |
| 417 (save-excursion | |
| 418 (goto-char (point-max)) | |
| 419 (while (re-search-backward re nil t) | |
| 420 (cond | |
| 421 ((match-end 2) | |
| 422 ;; Two time stamps | |
| 423 (setq ts (match-string 2) | |
| 424 te (match-string 3) | |
| 425 ts (time-to-seconds | |
| 426 (apply 'encode-time (org-parse-time-string ts))) | |
| 427 te (time-to-seconds | |
| 428 (apply 'encode-time (org-parse-time-string te))) | |
| 429 ts (if tstart (max ts tstart) ts) | |
| 430 te (if tend (min te tend) te) | |
| 431 dt (- te ts) | |
| 432 t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1))) | |
| 433 ((match-end 4) | |
| 434 ;; A naket time | |
| 435 (setq t1 (+ t1 (string-to-number (match-string 5)) | |
| 436 (* 60 (string-to-number (match-string 4)))))) | |
| 437 (t ;; A headline | |
| 438 (setq level (- (match-end 1) (match-beginning 1))) | |
| 439 (when (or (> t1 0) (> (aref ltimes level) 0)) | |
| 440 (loop for l from 0 to level do | |
| 441 (aset ltimes l (+ (aref ltimes l) t1))) | |
| 442 (setq t1 0 time (aref ltimes level)) | |
| 443 (loop for l from level to (1- lmax) do | |
| 444 (aset ltimes l 0)) | |
| 445 (goto-char (match-beginning 0)) | |
| 446 (put-text-property (point) (point-at-eol) :org-clock-minutes time))))) | |
| 447 (setq org-clock-file-total-minutes (aref ltimes 0))) | |
| 448 (set-buffer-modified-p bmp))) | |
| 449 | |
| 450 (defun org-clock-display (&optional total-only) | |
| 451 "Show subtree times in the entire buffer. | |
| 452 If TOTAL-ONLY is non-nil, only show the total time for the entire file | |
| 453 in the echo area." | |
| 454 (interactive) | |
| 455 (org-remove-clock-overlays) | |
| 456 (let (time h m p) | |
| 457 (org-clock-sum) | |
| 458 (unless total-only | |
| 459 (save-excursion | |
| 460 (goto-char (point-min)) | |
| 461 (while (or (and (equal (setq p (point)) (point-min)) | |
| 462 (get-text-property p :org-clock-minutes)) | |
| 463 (setq p (next-single-property-change | |
| 464 (point) :org-clock-minutes))) | |
| 465 (goto-char p) | |
| 466 (when (setq time (get-text-property p :org-clock-minutes)) | |
| 467 (org-put-clock-overlay time (funcall outline-level)))) | |
| 468 (setq h (/ org-clock-file-total-minutes 60) | |
| 469 m (- org-clock-file-total-minutes (* 60 h))) | |
| 470 ;; Arrange to remove the overlays upon next change. | |
| 471 (when org-remove-highlights-with-change | |
| 472 (org-add-hook 'before-change-functions 'org-remove-clock-overlays | |
| 473 nil 'local)))) | |
| 474 (message "Total file time: %d:%02d (%d hours and %d minutes)" h m h m))) | |
| 475 | |
| 476 (defvar org-clock-overlays nil) | |
| 477 (make-variable-buffer-local 'org-clock-overlays) | |
| 478 | |
| 479 (defun org-put-clock-overlay (time &optional level) | |
| 480 "Put an overlays on the current line, displaying TIME. | |
| 481 If LEVEL is given, prefix time with a corresponding number of stars. | |
| 482 This creates a new overlay and stores it in `org-clock-overlays', so that it | |
| 483 will be easy to remove." | |
| 484 (let* ((c 60) (h (floor (/ time 60))) (m (- time (* 60 h))) | |
| 485 (l (if level (org-get-valid-level level 0) 0)) | |
| 486 (off 0) | |
| 487 ov tx) | |
| 488 (org-move-to-column c) | |
| 489 (unless (eolp) (skip-chars-backward "^ \t")) | |
| 490 (skip-chars-backward " \t") | |
| 491 (setq ov (org-make-overlay (1- (point)) (point-at-eol)) | |
| 492 tx (concat (buffer-substring (1- (point)) (point)) | |
| 493 (make-string (+ off (max 0 (- c (current-column)))) ?.) | |
| 494 (org-add-props (format "%s %2d:%02d%s" | |
| 495 (make-string l ?*) h m | |
| 496 (make-string (- 16 l) ?\ )) | |
| 497 '(face secondary-selection)) | |
| 498 "")) | |
| 499 (if (not (featurep 'xemacs)) | |
| 500 (org-overlay-put ov 'display tx) | |
| 501 (org-overlay-put ov 'invisible t) | |
| 502 (org-overlay-put ov 'end-glyph (make-glyph tx))) | |
| 503 (push ov org-clock-overlays))) | |
| 504 | |
| 505 (defun org-remove-clock-overlays (&optional beg end noremove) | |
| 506 "Remove the occur highlights from the buffer. | |
| 507 BEG and END are ignored. If NOREMOVE is nil, remove this function | |
| 508 from the `before-change-functions' in the current buffer." | |
| 509 (interactive) | |
| 510 (unless org-inhibit-highlight-removal | |
| 511 (mapc 'org-delete-overlay org-clock-overlays) | |
| 512 (setq org-clock-overlays nil) | |
| 513 (unless noremove | |
| 514 (remove-hook 'before-change-functions | |
| 515 'org-remove-clock-overlays 'local)))) | |
| 516 | |
| 517 (defvar state) ;; dynamically scoped into this function | |
| 518 (defun org-clock-out-if-current () | |
| 519 "Clock out if the current entry contains the running clock. | |
| 520 This is used to stop the clock after a TODO entry is marked DONE, | |
| 521 and is only done if the variable `org-clock-out-when-done' is not nil." | |
| 522 (when (and org-clock-out-when-done | |
| 523 (member state org-done-keywords) | |
| 524 (equal (marker-buffer org-clock-marker) (current-buffer)) | |
| 525 (< (point) org-clock-marker) | |
| 526 (> (save-excursion (outline-next-heading) (point)) | |
| 527 org-clock-marker)) | |
| 528 ;; Clock out, but don't accept a logging message for this. | |
| 529 (let ((org-log-note-clock-out nil)) | |
| 530 (org-clock-out)))) | |
| 531 | |
| 532 (add-hook 'org-after-todo-state-change-hook | |
| 533 'org-clock-out-if-current) | |
| 534 | |
| 535 ;;;###autoload | |
| 536 (defun org-get-clocktable (&rest props) | |
| 537 "Get a formatted clocktable with parameters according to PROPS. | |
| 538 The table is created in a temporary buffer, fully formatted and | |
| 539 fontified, and then returned." | |
| 540 ;; Set the defaults | |
| 541 (setq props (plist-put props :name "clocktable")) | |
| 542 (unless (plist-member props :maxlevel) | |
| 543 (setq props (plist-put props :maxlevel 2))) | |
| 544 (unless (plist-member props :scope) | |
| 545 (setq props (plist-put props :scope 'agenda))) | |
| 546 (with-temp-buffer | |
| 547 (org-mode) | |
| 548 (org-create-dblock props) | |
| 549 (org-update-dblock) | |
| 550 (font-lock-fontify-buffer) | |
| 551 (forward-line 2) | |
| 552 (buffer-substring (point) (progn | |
| 553 (re-search-forward "^#\\+END" nil t) | |
| 554 (point-at-bol))))) | |
| 555 | |
| 556 (defun org-clock-report (&optional arg) | |
| 557 "Create a table containing a report about clocked time. | |
| 558 If the cursor is inside an existing clocktable block, then the table | |
| 559 will be updated. If not, a new clocktable will be inserted. | |
| 560 When called with a prefix argument, move to the first clock table in the | |
| 561 buffer and update it." | |
| 562 (interactive "P") | |
| 563 (org-remove-clock-overlays) | |
| 564 (when arg | |
| 565 (org-find-dblock "clocktable") | |
| 566 (org-show-entry)) | |
| 567 (if (org-in-clocktable-p) | |
| 568 (goto-char (org-in-clocktable-p)) | |
| 569 (org-create-dblock (list :name "clocktable" | |
| 570 :maxlevel 2 :scope 'file))) | |
| 571 (org-update-dblock)) | |
| 572 | |
| 573 (defun org-in-clocktable-p () | |
| 574 "Check if the cursor is in a clocktable." | |
| 575 (let ((pos (point)) start) | |
| 576 (save-excursion | |
| 577 (end-of-line 1) | |
| 578 (and (re-search-backward "^#\\+BEGIN:[ \t]+clocktable" nil t) | |
| 579 (setq start (match-beginning 0)) | |
| 580 (re-search-forward "^#\\+END:.*" nil t) | |
| 581 (>= (match-end 0) pos) | |
| 582 start)))) | |
| 583 | |
| 584 (defun org-clock-special-range (key &optional time as-strings) | |
| 585 "Return two times bordering a special time range. | |
| 586 Key is a symbol specifying the range and can be one of `today', `yesterday', | |
| 587 `thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'. | |
| 588 A week starts Monday 0:00 and ends Sunday 24:00. | |
| 589 The range is determined relative to TIME. TIME defaults to the current time. | |
| 590 The return value is a cons cell with two internal times like the ones | |
| 591 returned by `current time' or `encode-time'. if AS-STRINGS is non-nil, | |
| 592 the returned times will be formatted strings." | |
| 593 (if (integerp key) (setq key (intern (number-to-string key)))) | |
| 594 (let* ((tm (decode-time (or time (current-time)))) | |
| 595 (s 0) (m (nth 1 tm)) (h (nth 2 tm)) | |
| 596 (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) | |
| 597 (dow (nth 6 tm)) | |
| 598 (skey (symbol-name key)) | |
| 599 (shift 0) | |
| 600 s1 m1 h1 d1 month1 y1 diff ts te fm txt w date) | |
| 601 (cond | |
| 602 ((string-match "^[0-9]+$" skey) | |
| 603 (setq y (string-to-number skey) m 1 d 1 key 'year)) | |
| 604 ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)$" skey) | |
| 605 (setq y (string-to-number (match-string 1 skey)) | |
| 606 month (string-to-number (match-string 2 skey)) | |
| 607 d 1 key 'month)) | |
| 608 ((string-match "^\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)$" skey) | |
| 609 (require 'cal-iso) | |
| 610 (setq y (string-to-number (match-string 1 skey)) | |
| 611 w (string-to-number (match-string 2 skey))) | |
| 612 (setq date (calendar-gregorian-from-absolute | |
| 613 (calendar-absolute-from-iso (list w 1 y)))) | |
| 614 (setq d (nth 1 date) month (car date) y (nth 2 date) | |
| 615 key 'week)) | |
| 616 ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey) | |
| 617 (setq y (string-to-number (match-string 1 skey)) | |
| 618 month (string-to-number (match-string 2 skey)) | |
| 619 d (string-to-number (match-string 3 skey)) | |
| 620 key 'day)) | |
| 621 ((string-match "\\([-+][0-9]+\\)$" skey) | |
| 622 (setq shift (string-to-number (match-string 1 skey)) | |
| 623 key (intern (substring skey 0 (match-beginning 1)))))) | |
| 624 (unless shift | |
| 625 (cond ((eq key 'yesterday) (setq key 'today shift -1)) | |
| 626 ((eq key 'lastweek) (setq key 'week shift -1)) | |
| 627 ((eq key 'lastmonth) (setq key 'month shift -1)) | |
| 628 ((eq key 'lastyear) (setq key 'year shift -1)))) | |
| 629 (cond | |
| 630 ((memq key '(day today)) | |
| 631 (setq d (+ d shift) h 0 m 0 h1 24 m1 0)) | |
| 632 ((memq key '(week thisweek)) | |
| 633 (setq diff (+ (* -7 shift) (if (= dow 0) 6 (1- dow))) | |
| 634 m 0 h 0 d (- d diff) d1 (+ 7 d))) | |
| 635 ((memq key '(month thismonth)) | |
| 636 (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0)) | |
| 637 ((memq key '(year thisyear)) | |
| 638 (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) | |
| 639 (t (error "No such time block %s" key))) | |
| 640 (setq ts (encode-time s m h d month y) | |
| 641 te (encode-time (or s1 s) (or m1 m) (or h1 h) | |
| 642 (or d1 d) (or month1 month) (or y1 y))) | |
| 643 (setq fm (cdr org-time-stamp-formats)) | |
| 644 (cond | |
| 645 ((memq key '(day today)) | |
| 646 (setq txt (format-time-string "%A, %B %d, %Y" ts))) | |
| 647 ((memq key '(week thisweek)) | |
| 648 (setq txt (format-time-string "week %G-W%V" ts))) | |
| 649 ((memq key '(month thismonth)) | |
| 650 (setq txt (format-time-string "%B %Y" ts))) | |
| 651 ((memq key '(year thisyear)) | |
| 652 (setq txt (format-time-string "the year %Y" ts)))) | |
| 653 (if as-strings | |
| 654 (list (format-time-string fm ts) (format-time-string fm te) txt) | |
| 655 (list ts te txt)))) | |
| 656 | |
| 657 (defun org-clocktable-shift (dir n) | |
| 658 "Try to shift the :block date of the clocktable at point. | |
| 659 Point must be in the #+BEGIN: line of a clocktable, or this function | |
| 660 will throw an error. | |
| 661 DIR is a direction, a symbol `left', `right', `up', or `down'. | |
| 662 Both `left' and `down' shift the block toward the past, `up' and `right' | |
| 663 push it toward the future. | |
| 664 N is the number of shift steps to take. The size of the step depends on | |
| 665 the currently selected interval size." | |
| 666 (setq n (prefix-numeric-value n)) | |
| 667 (and (memq dir '(left down)) (setq n (- n))) | |
| 668 (save-excursion | |
| 669 (goto-char (point-at-bol)) | |
| 670 (if (not (looking-at "#\\+BEGIN: clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) | |
| 671 (error "Line needs a :block definition before this command works") | |
| 672 (let* ((b (match-beginning 1)) (e (match-end 1)) | |
| 673 (s (match-string 1)) | |
| 674 block shift ins y mw d date wp m) | |
| 675 (cond | |
| 676 ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\)\\([-+][0-9]+\\)?$" s) | |
| 677 (setq block (match-string 1 s) | |
| 678 shift (if (match-end 2) | |
| 679 (string-to-number (match-string 2 s)) | |
| 680 0)) | |
| 681 (setq shift (+ shift n)) | |
| 682 (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) | |
| 683 ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) | |
| 684 ;; 1 1 2 3 3 4 4 5 6 6 5 2 | |
| 685 (setq y (string-to-number (match-string 1 s)) | |
| 686 wp (and (match-end 3) (match-string 3 s)) | |
| 687 mw (and (match-end 4) (string-to-number (match-string 4 s))) | |
| 688 d (and (match-end 6) (string-to-number (match-string 6 s)))) | |
| 689 (cond | |
| 690 (d (setq ins (format-time-string | |
| 691 "%Y-%m-%d" | |
| 692 (encode-time 0 0 0 (+ d n) m y)))) | |
| 693 ((and wp mw (> (length wp) 0)) | |
| 694 (require 'cal-iso) | |
| 695 (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y)))) | |
| 696 (setq ins (format-time-string | |
| 697 "%G-W%V" | |
| 698 (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) | |
| 699 (mw | |
| 700 (setq ins (format-time-string | |
| 701 "%Y-%m" | |
| 702 (encode-time 0 0 0 1 (+ mw n) y)))) | |
| 703 (y | |
| 704 (setq ins (number-to-string (+ y n)))))) | |
| 705 (t (error "Cannot shift clocktable block"))) | |
| 706 (when ins | |
| 707 (goto-char b) | |
| 708 (insert ins) | |
| 709 (delete-region (point) (+ (point) (- e b))) | |
| 710 (beginning-of-line 1) | |
| 711 (org-update-dblock) | |
| 712 t))))) | |
| 713 | |
| 714 (defun org-dblock-write:clocktable (params) | |
| 715 "Write the standard clocktable." | |
| 716 (catch 'exit | |
| 717 (let* ((hlchars '((1 . "*") (2 . "/"))) | |
| 718 (ins (make-marker)) | |
| 719 (total-time nil) | |
| 720 (scope (plist-get params :scope)) | |
| 721 (tostring (plist-get params :tostring)) | |
| 722 (multifile (plist-get params :multifile)) | |
| 723 (header (plist-get params :header)) | |
| 724 (maxlevel (or (plist-get params :maxlevel) 3)) | |
| 725 (step (plist-get params :step)) | |
| 726 (emph (plist-get params :emphasize)) | |
| 727 (ts (plist-get params :tstart)) | |
| 728 (te (plist-get params :tend)) | |
| 729 (block (plist-get params :block)) | |
| 730 (link (plist-get params :link)) | |
| 731 ipos time p level hlc hdl | |
| 732 cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list) | |
| 733 (setq org-clock-file-total-minutes nil) | |
| 734 (when step | |
| 735 (unless (or block (and ts te)) | |
| 736 (error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'")) | |
| 737 (org-clocktable-steps params) | |
| 738 (throw 'exit nil)) | |
| 739 (when block | |
| 740 (setq cc (org-clock-special-range block nil t) | |
| 741 ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) | |
| 742 (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts))) | |
| 743 (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) | |
| 744 (when (and ts (listp ts)) | |
| 745 (setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts)))) | |
| 746 (when (and te (listp te)) | |
| 747 (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) | |
| 748 ;; Now the times are strings we can parse. | |
| 749 (if ts (setq ts (time-to-seconds | |
| 750 (apply 'encode-time (org-parse-time-string ts))))) | |
| 751 (if te (setq te (time-to-seconds | |
| 752 (apply 'encode-time (org-parse-time-string te))))) | |
| 753 (move-marker ins (point)) | |
| 754 (setq ipos (point)) | |
| 755 | |
| 756 ;; Get the right scope | |
| 757 (setq pos (point)) | |
| 758 (cond | |
| 759 ((and scope (listp scope) (symbolp (car scope))) | |
| 760 (setq scope (eval scope))) | |
| 761 ((eq scope 'agenda) | |
| 762 (setq scope (org-agenda-files t))) | |
| 763 ((eq scope 'agenda-with-archives) | |
| 764 (setq scope (org-agenda-files t)) | |
| 765 (setq scope (org-add-archive-files scope))) | |
| 766 ((eq scope 'file-with-archives) | |
| 767 (setq scope (org-add-archive-files (list (buffer-file-name))) | |
| 768 rm-file-column t))) | |
| 769 (setq scope-is-list (and scope (listp scope))) | |
| 770 (save-restriction | |
| 771 (cond | |
| 772 ((not scope)) | |
| 773 ((eq scope 'file) (widen)) | |
| 774 ((eq scope 'subtree) (org-narrow-to-subtree)) | |
| 775 ((eq scope 'tree) | |
| 776 (while (org-up-heading-safe)) | |
| 777 (org-narrow-to-subtree)) | |
| 778 ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$" | |
| 779 (symbol-name scope))) | |
| 780 (setq level (string-to-number (match-string 1 (symbol-name scope)))) | |
| 781 (catch 'exit | |
| 782 (while (org-up-heading-safe) | |
| 783 (looking-at outline-regexp) | |
| 784 (if (<= (org-reduced-level (funcall outline-level)) level) | |
| 785 (throw 'exit nil)))) | |
| 786 (org-narrow-to-subtree)) | |
| 787 (scope-is-list | |
| 788 (let* ((files scope) | |
| 789 (scope 'agenda) | |
| 790 (p1 (copy-sequence params)) | |
| 791 file) | |
| 792 (setq p1 (plist-put p1 :tostring t)) | |
| 793 (setq p1 (plist-put p1 :multifile t)) | |
| 794 (setq p1 (plist-put p1 :scope 'file)) | |
| 795 (org-prepare-agenda-buffers files) | |
| 796 (while (setq file (pop files)) | |
| 797 (with-current-buffer (find-buffer-visiting file) | |
| 798 (setq tbl1 (org-dblock-write:clocktable p1)) | |
| 799 (when tbl1 | |
| 800 (push (org-clocktable-add-file | |
| 801 file | |
| 802 (concat "| |*File time*|*" | |
| 803 (org-minutes-to-hh:mm-string | |
| 804 org-clock-file-total-minutes) | |
| 805 "*|\n" | |
| 806 tbl1)) tbl) | |
| 807 (setq total-time (+ (or total-time 0) | |
| 808 org-clock-file-total-minutes)))))))) | |
| 809 (goto-char pos) | |
| 810 | |
| 811 (unless scope-is-list | |
| 812 (org-clock-sum ts te) | |
| 813 (goto-char (point-min)) | |
| 814 (while (setq p (next-single-property-change (point) :org-clock-minutes)) | |
| 815 (goto-char p) | |
| 816 (when (setq time (get-text-property p :org-clock-minutes)) | |
| 817 (save-excursion | |
| 818 (beginning-of-line 1) | |
| 819 (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@:]+:\\)?[ \t]*$")) | |
| 820 (setq level (org-reduced-level | |
| 821 (- (match-end 1) (match-beginning 1)))) | |
| 822 (<= level maxlevel)) | |
| 823 (setq hlc (if emph (or (cdr (assoc level hlchars)) "") "") | |
| 824 hdl (if (not link) | |
| 825 (match-string 2) | |
| 826 (org-make-link-string | |
| 827 (format "file:%s::%s" | |
| 828 (buffer-file-name) | |
| 829 (save-match-data | |
| 830 (org-make-org-heading-search-string | |
| 831 (match-string 2)))) | |
| 832 (match-string 2)))) | |
| 833 (if (and (not multifile) (= level 1)) (push "|-" tbl)) | |
| 834 (push (concat | |
| 835 "| " (int-to-string level) "|" hlc hdl hlc " |" | |
| 836 (make-string (1- level) ?|) | |
| 837 hlc (org-minutes-to-hh:mm-string time) hlc | |
| 838 " |") tbl)))))) | |
| 839 (setq tbl (nreverse tbl)) | |
| 840 (if tostring | |
| 841 (if tbl (mapconcat 'identity tbl "\n") nil) | |
| 842 (goto-char ins) | |
| 843 (insert-before-markers | |
| 844 (or header | |
| 845 (concat | |
| 846 "Clock summary at [" | |
| 847 (substring | |
| 848 (format-time-string (cdr org-time-stamp-formats)) | |
| 849 1 -1) | |
| 850 "]" | |
| 851 (if block (concat ", for " range-text ".") "") | |
| 852 "\n\n")) | |
| 853 (if scope-is-list "|File" "") | |
| 854 "|L|Headline|Time|\n") | |
| 855 (setq total-time (or total-time org-clock-file-total-minutes)) | |
| 856 (insert-before-markers | |
| 857 "|-\n|" | |
| 858 (if scope-is-list "|" "") | |
| 859 "|" | |
| 860 "*Total time*| *" | |
| 861 (org-minutes-to-hh:mm-string (or total-time 0)) | |
| 862 "*|\n|-\n") | |
| 863 (setq tbl (delq nil tbl)) | |
| 864 (if (and (stringp (car tbl)) (> (length (car tbl)) 1) | |
| 865 (equal (substring (car tbl) 0 2) "|-")) | |
| 866 (pop tbl)) | |
| 867 (insert-before-markers (mapconcat | |
| 868 'identity (delq nil tbl) | |
| 869 (if scope-is-list "\n|-\n" "\n"))) | |
| 870 (backward-delete-char 1) | |
| 871 (goto-char ipos) | |
| 872 (skip-chars-forward "^|") | |
| 873 (org-table-align) | |
| 874 (when rm-file-column | |
| 875 (forward-char 1) | |
| 876 (org-table-delete-column))))))) | |
| 877 | |
| 878 (defun org-clocktable-steps (params) | |
| 879 (let* ((p1 (copy-sequence params)) | |
| 880 (ts (plist-get p1 :tstart)) | |
| 881 (te (plist-get p1 :tend)) | |
| 882 (step0 (plist-get p1 :step)) | |
| 883 (step (cdr (assoc step0 '((day . 86400) (week . 604800))))) | |
| 884 (block (plist-get p1 :block)) | |
| 885 cc range-text) | |
| 886 (when block | |
| 887 (setq cc (org-clock-special-range block nil t) | |
| 888 ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) | |
| 889 (if ts (setq ts (time-to-seconds | |
| 890 (apply 'encode-time (org-parse-time-string ts))))) | |
| 891 (if te (setq te (time-to-seconds | |
| 892 (apply 'encode-time (org-parse-time-string te))))) | |
| 893 (setq p1 (plist-put p1 :header "")) | |
| 894 (setq p1 (plist-put p1 :step nil)) | |
| 895 (setq p1 (plist-put p1 :block nil)) | |
| 896 (while (< ts te) | |
| 897 (or (bolp) (insert "\n")) | |
| 898 (setq p1 (plist-put p1 :tstart (format-time-string | |
| 899 (car org-time-stamp-formats) | |
| 900 (seconds-to-time ts)))) | |
| 901 (setq p1 (plist-put p1 :tend (format-time-string | |
| 902 (car org-time-stamp-formats) | |
| 903 (seconds-to-time (setq ts (+ ts step)))))) | |
| 904 (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ") | |
| 905 (plist-get p1 :tstart) "\n") | |
| 906 (org-dblock-write:clocktable p1) | |
| 907 (re-search-forward "#\\+END:") | |
| 908 (end-of-line 0)))) | |
| 909 | |
| 910 | |
| 911 (defun org-clocktable-add-file (file table) | |
| 912 (if table | |
| 913 (let ((lines (org-split-string table "\n")) | |
| 914 (ff (file-name-nondirectory file))) | |
| 915 (mapconcat 'identity | |
| 916 (mapcar (lambda (x) | |
| 917 (if (string-match org-table-dataline-regexp x) | |
| 918 (concat "|" ff x) | |
| 919 x)) | |
| 920 lines) | |
| 921 "\n")))) | |
| 922 | |
| 923 (provide 'org-clock) | |
| 924 | |
| 925 ;;; org-clock.el ends here | |
| 926 | |
| 927 |