[Timeline] Moving timeline code into separate package
This commit is contained in:
parent
3787cef333
commit
caa13eb1d3
|
@ -915,362 +915,6 @@ Current Task: %`org-clock-current-task; "
|
||||||
"Visit OneNote document on PATH."
|
"Visit OneNote document on PATH."
|
||||||
(w32-shell-execute "open" path)))
|
(w32-shell-execute "open" path)))
|
||||||
|
|
||||||
|
|
||||||
;;; Reporting
|
|
||||||
|
|
||||||
;; All of what follows should be available in org-mode somewhere, but doing it
|
|
||||||
;; myself was faster and also more fun :)
|
|
||||||
|
|
||||||
(defgroup timeline-reporting nil
|
|
||||||
"Functionality for formatting timelines."
|
|
||||||
:tag "Timeline Formatter"
|
|
||||||
:group 'applications)
|
|
||||||
|
|
||||||
(require 'dash)
|
|
||||||
|
|
||||||
(defun db/org-map-clock-lines-and-entries (clockline-fn headline-fn)
|
|
||||||
"Iterate point over all clocklines and headlines of the current buffer.
|
|
||||||
For each clockline, call CLOCKLINE-FN with the starting and
|
|
||||||
ending time as arguments and point on the beginning of the line.
|
|
||||||
For each headline, call HEADLINE-FN with no arguments and point
|
|
||||||
on the start of the headline. Traversal will be done from the
|
|
||||||
end of the file upwards. If the buffer is narrowed, only this
|
|
||||||
region will be traversed."
|
|
||||||
(when (eq major-mode 'org-mode)
|
|
||||||
(let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
|
|
||||||
org-clock-string
|
|
||||||
"[ \t]*\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)")))
|
|
||||||
(save-excursion
|
|
||||||
(goto-char (point-max))
|
|
||||||
(while (re-search-backward re nil t)
|
|
||||||
(cond
|
|
||||||
((match-end 2)
|
|
||||||
;; Two time stamps.
|
|
||||||
(save-mark-and-excursion
|
|
||||||
(funcall clockline-fn (match-string 2) (match-string 3))))
|
|
||||||
(t
|
|
||||||
;; A headline
|
|
||||||
(save-mark-and-excursion
|
|
||||||
(funcall headline-fn)))))))))
|
|
||||||
|
|
||||||
(defun db/org-clocking-time-in-range (tstart tend)
|
|
||||||
"Return list of all tasks in the current buffer together with
|
|
||||||
their clocking times that are between TSTART and TEND. The
|
|
||||||
resulting list consists of elements of the form
|
|
||||||
|
|
||||||
(MARKER . CLOCK-TIMES)
|
|
||||||
|
|
||||||
where MARKER is a marker to the beginning of the corresponding
|
|
||||||
heading and CLOCK-TIMES is a list of cons cells of the
|
|
||||||
form (START . END), where START and END are the starting and
|
|
||||||
ending times of a clock line for this task. START and END are
|
|
||||||
given as seconds since the epoch, as a floating point number. No
|
|
||||||
truncation with respect to TSTART and TEND is done, i.e., START
|
|
||||||
or END may occassionally lie outside of these limits, but it is
|
|
||||||
always true that TSTART ≤ END ≤ TEND or TSTART ≤ START ≤ TEND."
|
|
||||||
;; adapted from `org-clock-sum’
|
|
||||||
(when (eq major-mode 'org-mode)
|
|
||||||
(let* ((tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart))
|
|
||||||
((consp tstart) (float-time tstart))
|
|
||||||
(t tstart)))
|
|
||||||
(tend (cond ((stringp tend) (org-time-string-to-seconds tend))
|
|
||||||
((consp tend) (float-time tend))
|
|
||||||
(t tend)))
|
|
||||||
task-clock-times times)
|
|
||||||
(db/org-map-clock-lines-and-entries
|
|
||||||
;; when on clock line, collect times
|
|
||||||
#'(lambda (start end)
|
|
||||||
(let* ((ts (float-time
|
|
||||||
(apply #'encode-time (org-parse-time-string start))))
|
|
||||||
(te (float-time
|
|
||||||
(apply #'encode-time (org-parse-time-string end))))
|
|
||||||
(dt (- (if tend (min te tend) te)
|
|
||||||
(if tstart (max ts tstart) ts))))
|
|
||||||
(when (> dt 0)
|
|
||||||
(push (cons ts te) times))))
|
|
||||||
;; when on headlines, store away collected clocklines
|
|
||||||
#'(lambda ()
|
|
||||||
(when (and org-clock-report-include-clocking-task
|
|
||||||
(eq (org-clocking-buffer) (current-buffer))
|
|
||||||
(eq (marker-position org-clock-hd-marker) (point))
|
|
||||||
(or (and tstart
|
|
||||||
(<= tstart (float-time org-clock-start-time) tend))
|
|
||||||
(and tend
|
|
||||||
(<= tstart (float-time) tend))))
|
|
||||||
(push (cons (float-time org-clock-start-time) (float-time))
|
|
||||||
times))
|
|
||||||
(when (not (null times))
|
|
||||||
(push (cons (point-marker) times) task-clock-times)
|
|
||||||
(setq times nil))))
|
|
||||||
task-clock-times)))
|
|
||||||
|
|
||||||
(defun db/org-timeline-in-range (tstart tend &optional files)
|
|
||||||
"Return list of clocked times from FILES between TSTART and
|
|
||||||
TEND. Each element in this list is of the form
|
|
||||||
|
|
||||||
(START END MARKER),
|
|
||||||
|
|
||||||
where START, END, MARKER are as returned by
|
|
||||||
`db/org-clocking-time-in-range’, which see. Entries in the
|
|
||||||
resulting list are sorted by START, ascending."
|
|
||||||
(let (timeline-of-files turned-around-timeline)
|
|
||||||
(setq timeline-of-files
|
|
||||||
(->> (or files org-agenda-files)
|
|
||||||
(cl-remove-if-not #'file-exists-p)
|
|
||||||
(cl-mapcan #'(lambda (file)
|
|
||||||
(with-current-buffer (or (get-file-buffer file)
|
|
||||||
(find-file-noselect file))
|
|
||||||
(db/org-clocking-time-in-range tstart tend))))))
|
|
||||||
(dolist (entry timeline-of-files)
|
|
||||||
(dolist (clock-time (cdr entry))
|
|
||||||
(push (list (car clock-time) (cdr clock-time) (car entry))
|
|
||||||
turned-around-timeline)))
|
|
||||||
(sort turned-around-timeline
|
|
||||||
(lambda (entry-1 entry-2)
|
|
||||||
(< (car entry-1) (car entry-2))))))
|
|
||||||
|
|
||||||
(defun db/org-cluster-timeline-same-category (timeline)
|
|
||||||
"Cluster TIMELINE into consecutive entries with equal category.
|
|
||||||
Markers to org mode tasks are combined into a list."
|
|
||||||
(let ((new-timeline (-partition-by (lambda (entry)
|
|
||||||
(let ((marker (third entry)))
|
|
||||||
(org-entry-get marker "CATEGORY")))
|
|
||||||
timeline)))
|
|
||||||
(mapcar (lambda (cluster)
|
|
||||||
(list (first (first cluster)) ; start of first entry
|
|
||||||
(second (car (last cluster))) ; end of last entry
|
|
||||||
(mapcar #'third cluster)))
|
|
||||||
new-timeline)))
|
|
||||||
|
|
||||||
(defun db/org-skip-short-entries-in-timeline (threshold timeline)
|
|
||||||
"Skip short entries in TIMELINE.
|
|
||||||
A slot is short if it is not longer than THRESHOLD seconds.
|
|
||||||
Resulting gaps are distributed evenly among adjacent slots."
|
|
||||||
(let ((start (first (first timeline)))
|
|
||||||
(end (second (car (last timeline))))
|
|
||||||
new-timeline)
|
|
||||||
;; remove all slots that are too short
|
|
||||||
(setq new-timeline
|
|
||||||
(cl-remove-if (lambda (entry)
|
|
||||||
(<= (- (second entry) (first entry))
|
|
||||||
threshold))
|
|
||||||
timeline))
|
|
||||||
|
|
||||||
;; reset start and end times
|
|
||||||
(setf (first (first new-timeline)) start)
|
|
||||||
(setf (second (car (last new-timeline))) end)
|
|
||||||
|
|
||||||
;; distribute gaps evenly among adjacent slots
|
|
||||||
(do ((sub-timeline new-timeline (cdr sub-timeline)))
|
|
||||||
((null (cdr sub-timeline)))
|
|
||||||
(let* ((entry-1 (first sub-timeline))
|
|
||||||
(entry-2 (second sub-timeline))
|
|
||||||
(end-1 (second entry-1))
|
|
||||||
(start-2 (first entry-2)))
|
|
||||||
(when (not (= end-1 start-2))
|
|
||||||
(let ((middle (/ (+ end-1 start-2) 2)))
|
|
||||||
(setf (second entry-1) middle)
|
|
||||||
(setf (first entry-2) middle)))))
|
|
||||||
new-timeline))
|
|
||||||
|
|
||||||
(defun db/org-get-headline (marker)
|
|
||||||
"Get headline of task at MARKER."
|
|
||||||
(assert (markerp marker))
|
|
||||||
(save-match-data
|
|
||||||
(let* ((heading (save-mark-and-excursion
|
|
||||||
(with-current-buffer (marker-buffer marker)
|
|
||||||
(goto-char (marker-position marker))
|
|
||||||
(thing-at-point 'line t)))))
|
|
||||||
(string-match (format "^\\(\\*+\\)\\(?: +%s\\)?\\(?: %s\\)? +\\(.*?\\)[ \t]*\\(?::\\(?:[A-Za-z_]+:\\)+\\)?$"
|
|
||||||
(regexp-opt org-todo-keywords-1)
|
|
||||||
org-priority-regexp)
|
|
||||||
heading)
|
|
||||||
(match-string 4 heading))))
|
|
||||||
|
|
||||||
(defcustom timeline-short-task-threshold 300
|
|
||||||
"Duration of task to be considered as short."
|
|
||||||
:group 'timeline-reporting
|
|
||||||
:type 'integer)
|
|
||||||
|
|
||||||
(defun db/org-format-timeline (tstart tend &optional files)
|
|
||||||
"Display timeline of tasks in FILES between TSTART and TEND.
|
|
||||||
When not given, FILES defaults to `org-agenda-files’. Short
|
|
||||||
slots are removed, and afterwards slots are clusted by category.
|
|
||||||
When called interactively, START and END are queried with
|
|
||||||
`org-read-date’."
|
|
||||||
(interactive (list (org-read-date nil nil nil "Start time: ")
|
|
||||||
(org-read-date nil nil nil "End time: ")))
|
|
||||||
(let ((timeline (->> (db/org-timeline-in-range tstart tend files)
|
|
||||||
(db/org-skip-short-entries-in-timeline
|
|
||||||
timeline-short-task-threshold)
|
|
||||||
db/org-cluster-timeline-same-category)))
|
|
||||||
(let ((target-buffer (get-buffer-create " *Org Timeline*")))
|
|
||||||
(with-current-buffer target-buffer
|
|
||||||
(erase-buffer)
|
|
||||||
(org-mode)
|
|
||||||
(insert "|--|\n")
|
|
||||||
(insert "| Category | Start | End | Duration | Task |\n")
|
|
||||||
(insert "|--|\n")
|
|
||||||
(dolist (cluster timeline)
|
|
||||||
(cl-destructuring-bind (start end markers) cluster
|
|
||||||
(insert (format "| %s | %s | %s | %s min | "
|
|
||||||
(org-entry-get (first markers) "CATEGORY")
|
|
||||||
(format-time-string "%Y-%m-%d %H:%M" start)
|
|
||||||
(format-time-string "%Y-%m-%d %H:%M" end)
|
|
||||||
(floor (/ (- end start) 60))))
|
|
||||||
;; insert headline line by line, but only once
|
|
||||||
(dolist (headline (->> (mapcar #'db/org-get-headline markers)
|
|
||||||
-uniq
|
|
||||||
(-interpose "|\n |||||")))
|
|
||||||
(insert headline))
|
|
||||||
(insert "\n")))
|
|
||||||
(insert "|--|\n")
|
|
||||||
(goto-char (point-min))
|
|
||||||
(org-table-align))
|
|
||||||
(display-buffer target-buffer)
|
|
||||||
t)))
|
|
||||||
|
|
||||||
(defun db/org-format-timeline-of-day (date &optional files)
|
|
||||||
"Format timeline of given DATE.
|
|
||||||
DATE should be a string of the form %Y-%m-%d. When called
|
|
||||||
interactively, this date will be queried with `org-read-date’.
|
|
||||||
The timeline will be formatted for DATE starting at 00:00 and
|
|
||||||
ending at 23:61. When not given, FILES defaults to
|
|
||||||
`org-agenda-files’."
|
|
||||||
(interactive (list (org-read-date nil nil)))
|
|
||||||
(db/org-format-timeline (concat date " 00:00")
|
|
||||||
(concat date " 23:61")
|
|
||||||
files))
|
|
||||||
|
|
||||||
|
|
||||||
;;; Manipulating Clock Lines
|
|
||||||
|
|
||||||
(defun db/org-insert-clockline (time-1 time-2)
|
|
||||||
"Insert new clock line from TIME-1 to TIME-2 at the beginning
|
|
||||||
of the current line. TIME-1 and TIME-2 must be given in a
|
|
||||||
format understandable by `format-time-string’, which see.
|
|
||||||
Saves mark and point."
|
|
||||||
(let ((timestamp-format (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")))
|
|
||||||
(save-mark-and-excursion
|
|
||||||
(beginning-of-line)
|
|
||||||
(indent-according-to-mode)
|
|
||||||
(insert "CLOCK: ")
|
|
||||||
(insert (format-time-string timestamp-format time-1))
|
|
||||||
(insert "--")
|
|
||||||
(insert (format-time-string timestamp-format time-2))
|
|
||||||
(org-clock-update-time-maybe))))
|
|
||||||
|
|
||||||
(defun db/org-add-clocking-time (starting-time ending-time)
|
|
||||||
"Add \"CLOCK:\" line to the task under point in the current org-mode file."
|
|
||||||
(interactive
|
|
||||||
(list (starting-time (org-read-date 4 'totime nil
|
|
||||||
"Start:" (current-time) nil t))
|
|
||||||
(ending-time (org-read-date 4 'totime nil
|
|
||||||
"End:" (current-time) nil t))))
|
|
||||||
(if (not (eq major-mode 'org-mode))
|
|
||||||
(user-error "Must be in org mode")
|
|
||||||
(save-mark-and-excursion
|
|
||||||
(org-clock-find-position nil)
|
|
||||||
(open-line 1)
|
|
||||||
(db/org-insert-clockline starting-time ending-time))))
|
|
||||||
|
|
||||||
(bind-key "C-c C-x C-a" #'db/org-add-clocking-time org-mode-map)
|
|
||||||
|
|
||||||
(defun db/org-add-clock-line-to-marker (target-marker start end)
|
|
||||||
"Add clock line with START and END time to task identified by TARGET-MARKER.
|
|
||||||
START and END must be given as time objects as returned by
|
|
||||||
`encode-time’, or as an integer or float denoting seconds since
|
|
||||||
1970-01-01. TARGET-MARKER must be positioned on the task where
|
|
||||||
the clock line is to be added to."
|
|
||||||
(when (not (markerp target-marker))
|
|
||||||
(user-error "Marker not valid."))
|
|
||||||
(let ((new-start (float-time start))
|
|
||||||
(new-end (float-time end)))
|
|
||||||
(with-current-buffer (marker-buffer target-marker)
|
|
||||||
(db/org-map-clock-lines-and-entries
|
|
||||||
(lambda (timestamp-1 timestamp-2)
|
|
||||||
(let ((current-start (float-time
|
|
||||||
(apply #'encode-time
|
|
||||||
(org-parse-time-string timestamp-1))))
|
|
||||||
(current-end (float-time
|
|
||||||
(apply #'encode-time
|
|
||||||
(org-parse-time-string timestamp-2))))
|
|
||||||
(kill-whole-line nil) ; don’t delete newlines if not asked to
|
|
||||||
)
|
|
||||||
(cond
|
|
||||||
;; if the current clock line is completely contained within the
|
|
||||||
;; given period, delete it
|
|
||||||
((and (<= new-start current-start current-end new-end))
|
|
||||||
(kill-whole-line))
|
|
||||||
;; if the current clock line completely contains the given one,
|
|
||||||
;; split it
|
|
||||||
((and (<= current-start new-start new-end current-end))
|
|
||||||
(beginning-of-line)
|
|
||||||
(kill-line)
|
|
||||||
(db/org-insert-clockline current-start new-start)
|
|
||||||
(open-line 1)
|
|
||||||
(db/org-insert-clockline new-end current-end))
|
|
||||||
;; New interval overlaps beginning of current line
|
|
||||||
((<= new-start current-start new-end current-end)
|
|
||||||
(beginning-of-line)
|
|
||||||
(kill-line)
|
|
||||||
(db/org-insert-clockline new-end current-end))
|
|
||||||
;; New interval overlaps at end of current line
|
|
||||||
((<= current-start new-start current-end new-end)
|
|
||||||
(beginning-of-line)
|
|
||||||
(kill-line)
|
|
||||||
(db/org-insert-clockline current-start new-start)))))
|
|
||||||
|
|
||||||
;; Keep headline as they are, i.e., do nothing
|
|
||||||
(lambda ())))
|
|
||||||
|
|
||||||
;; Finally add the new clock line
|
|
||||||
(org-with-point-at target-marker
|
|
||||||
(db/org-add-clocking-time new-start new-end))))
|
|
||||||
|
|
||||||
(defun db/org-clock-lines-of-task (marker)
|
|
||||||
"Return list of all clock lines of task under MARKER.
|
|
||||||
Each clock line is represented as a cons cell (START . END),
|
|
||||||
where both START and END are the starting and ending times of the
|
|
||||||
corresponding clock lines, encoded as a float denoting the
|
|
||||||
seconds since the epoch. Includes clock lines of all subtrees as
|
|
||||||
well. The order of the entries in the resulting list will be
|
|
||||||
reversed of what it is in the subtree of MARKER."
|
|
||||||
(when (not (markerp marker))
|
|
||||||
(user-error "Marker not valid."))
|
|
||||||
(let ((clock-lines nil))
|
|
||||||
(save-mark-and-excursion
|
|
||||||
(org-with-point-at marker
|
|
||||||
(org-narrow-to-subtree)
|
|
||||||
(db/org-map-clock-lines-and-entries
|
|
||||||
(lambda (start end)
|
|
||||||
(push (cons (org-time-string-to-seconds start)
|
|
||||||
(org-time-string-to-seconds end))
|
|
||||||
clock-lines))
|
|
||||||
(lambda ()))))
|
|
||||||
clock-lines))
|
|
||||||
|
|
||||||
(defun db/org-copy-clock-lines (source-id target-id)
|
|
||||||
"Copy clock lines from one task to another, adapting clock
|
|
||||||
lines in the file of TARGET-ID accordingly.
|
|
||||||
|
|
||||||
Both SOURCE-ID and TARGET-ID must designate known org-mode
|
|
||||||
tasks. Copies all clock lines attached to SOURCE-ID or to one of
|
|
||||||
its subtree."
|
|
||||||
(let ((source-marker (org-id-find source-id :get-marker))
|
|
||||||
(target-marker (org-id-find target-id :get-marker)))
|
|
||||||
(cl-assert (markerp source-marker)
|
|
||||||
"Source task %s not found" source-id)
|
|
||||||
(cl-assert (markerp target-marker)
|
|
||||||
"Target task %s not found" target-id)
|
|
||||||
|
|
||||||
;; We first fetch the relevant clock-lines into memory, and then add them to
|
|
||||||
;; the target task one by one, adjusting the other clock lines in between;
|
|
||||||
;; this is rather inefficient, but we will fix this only when we need it.
|
|
||||||
(dolist (clock-line (db/org-clock-lines-of-task source-marker))
|
|
||||||
(db/org-add-clock-line-to-marker target-marker
|
|
||||||
(car clock-line) (cdr clock-line)))))
|
|
||||||
|
|
||||||
|
|
||||||
;;; End
|
;;; End
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,359 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;;; Reporting
|
||||||
|
|
||||||
|
;; All of what follows should be available in org-mode somewhere, but doing it
|
||||||
|
;; myself was faster and also more fun :)
|
||||||
|
|
||||||
|
(defgroup timeline-reporting nil
|
||||||
|
"Functionality for formatting timelines."
|
||||||
|
:tag "Timeline Formatter"
|
||||||
|
:group 'applications)
|
||||||
|
|
||||||
|
(require 'dash)
|
||||||
|
|
||||||
|
(defun db/org-map-clock-lines-and-entries (clockline-fn headline-fn)
|
||||||
|
"Iterate point over all clocklines and headlines of the current buffer.
|
||||||
|
For each clockline, call CLOCKLINE-FN with the starting and
|
||||||
|
ending time as arguments and point on the beginning of the line.
|
||||||
|
For each headline, call HEADLINE-FN with no arguments and point
|
||||||
|
on the start of the headline. Traversal will be done from the
|
||||||
|
end of the file upwards. If the buffer is narrowed, only this
|
||||||
|
region will be traversed."
|
||||||
|
(when (eq major-mode 'org-mode)
|
||||||
|
(let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
|
||||||
|
org-clock-string
|
||||||
|
"[ \t]*\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)")))
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-max))
|
||||||
|
(while (re-search-backward re nil t)
|
||||||
|
(cond
|
||||||
|
((match-end 2)
|
||||||
|
;; Two time stamps.
|
||||||
|
(save-mark-and-excursion
|
||||||
|
(funcall clockline-fn (match-string 2) (match-string 3))))
|
||||||
|
(t
|
||||||
|
;; A headline
|
||||||
|
(save-mark-and-excursion
|
||||||
|
(funcall headline-fn)))))))))
|
||||||
|
|
||||||
|
(defun db/org-clocking-time-in-range (tstart tend)
|
||||||
|
"Return list of all tasks in the current buffer together with
|
||||||
|
their clocking times that are between TSTART and TEND. The
|
||||||
|
resulting list consists of elements of the form
|
||||||
|
|
||||||
|
(MARKER . CLOCK-TIMES)
|
||||||
|
|
||||||
|
where MARKER is a marker to the beginning of the corresponding
|
||||||
|
heading and CLOCK-TIMES is a list of cons cells of the
|
||||||
|
form (START . END), where START and END are the starting and
|
||||||
|
ending times of a clock line for this task. START and END are
|
||||||
|
given as seconds since the epoch, as a floating point number. No
|
||||||
|
truncation with respect to TSTART and TEND is done, i.e., START
|
||||||
|
or END may occassionally lie outside of these limits, but it is
|
||||||
|
always true that TSTART ≤ END ≤ TEND or TSTART ≤ START ≤ TEND."
|
||||||
|
;; adapted from `org-clock-sum’
|
||||||
|
(when (eq major-mode 'org-mode)
|
||||||
|
(let* ((tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart))
|
||||||
|
((consp tstart) (float-time tstart))
|
||||||
|
(t tstart)))
|
||||||
|
(tend (cond ((stringp tend) (org-time-string-to-seconds tend))
|
||||||
|
((consp tend) (float-time tend))
|
||||||
|
(t tend)))
|
||||||
|
task-clock-times times)
|
||||||
|
(db/org-map-clock-lines-and-entries
|
||||||
|
;; when on clock line, collect times
|
||||||
|
#'(lambda (start end)
|
||||||
|
(let* ((ts (float-time
|
||||||
|
(apply #'encode-time (org-parse-time-string start))))
|
||||||
|
(te (float-time
|
||||||
|
(apply #'encode-time (org-parse-time-string end))))
|
||||||
|
(dt (- (if tend (min te tend) te)
|
||||||
|
(if tstart (max ts tstart) ts))))
|
||||||
|
(when (> dt 0)
|
||||||
|
(push (cons ts te) times))))
|
||||||
|
;; when on headlines, store away collected clocklines
|
||||||
|
#'(lambda ()
|
||||||
|
(when (and org-clock-report-include-clocking-task
|
||||||
|
(eq (org-clocking-buffer) (current-buffer))
|
||||||
|
(eq (marker-position org-clock-hd-marker) (point))
|
||||||
|
(or (and tstart
|
||||||
|
(<= tstart (float-time org-clock-start-time) tend))
|
||||||
|
(and tend
|
||||||
|
(<= tstart (float-time) tend))))
|
||||||
|
(push (cons (float-time org-clock-start-time) (float-time))
|
||||||
|
times))
|
||||||
|
(when (not (null times))
|
||||||
|
(push (cons (point-marker) times) task-clock-times)
|
||||||
|
(setq times nil))))
|
||||||
|
task-clock-times)))
|
||||||
|
|
||||||
|
(defun db/org-timeline-in-range (tstart tend &optional files)
|
||||||
|
"Return list of clocked times from FILES between TSTART and
|
||||||
|
TEND. Each element in this list is of the form
|
||||||
|
|
||||||
|
(START END MARKER),
|
||||||
|
|
||||||
|
where START, END, MARKER are as returned by
|
||||||
|
`db/org-clocking-time-in-range’, which see. Entries in the
|
||||||
|
resulting list are sorted by START, ascending."
|
||||||
|
(let (timeline-of-files turned-around-timeline)
|
||||||
|
(setq timeline-of-files
|
||||||
|
(->> (or files org-agenda-files)
|
||||||
|
(cl-remove-if-not #'file-exists-p)
|
||||||
|
(cl-mapcan #'(lambda (file)
|
||||||
|
(with-current-buffer (or (get-file-buffer file)
|
||||||
|
(find-file-noselect file))
|
||||||
|
(db/org-clocking-time-in-range tstart tend))))))
|
||||||
|
(dolist (entry timeline-of-files)
|
||||||
|
(dolist (clock-time (cdr entry))
|
||||||
|
(push (list (car clock-time) (cdr clock-time) (car entry))
|
||||||
|
turned-around-timeline)))
|
||||||
|
(sort turned-around-timeline
|
||||||
|
(lambda (entry-1 entry-2)
|
||||||
|
(< (car entry-1) (car entry-2))))))
|
||||||
|
|
||||||
|
(defun db/org-cluster-timeline-same-category (timeline)
|
||||||
|
"Cluster TIMELINE into consecutive entries with equal category.
|
||||||
|
Markers to org mode tasks are combined into a list."
|
||||||
|
(let ((new-timeline (-partition-by (lambda (entry)
|
||||||
|
(let ((marker (third entry)))
|
||||||
|
(org-entry-get marker "CATEGORY")))
|
||||||
|
timeline)))
|
||||||
|
(mapcar (lambda (cluster)
|
||||||
|
(list (first (first cluster)) ; start of first entry
|
||||||
|
(second (car (last cluster))) ; end of last entry
|
||||||
|
(mapcar #'third cluster)))
|
||||||
|
new-timeline)))
|
||||||
|
|
||||||
|
(defun db/org-skip-short-entries-in-timeline (threshold timeline)
|
||||||
|
"Skip short entries in TIMELINE.
|
||||||
|
A slot is short if it is not longer than THRESHOLD seconds.
|
||||||
|
Resulting gaps are distributed evenly among adjacent slots."
|
||||||
|
(let ((start (first (first timeline)))
|
||||||
|
(end (second (car (last timeline))))
|
||||||
|
new-timeline)
|
||||||
|
;; remove all slots that are too short
|
||||||
|
(setq new-timeline
|
||||||
|
(cl-remove-if (lambda (entry)
|
||||||
|
(<= (- (second entry) (first entry))
|
||||||
|
threshold))
|
||||||
|
timeline))
|
||||||
|
|
||||||
|
;; reset start and end times
|
||||||
|
(setf (first (first new-timeline)) start)
|
||||||
|
(setf (second (car (last new-timeline))) end)
|
||||||
|
|
||||||
|
;; distribute gaps evenly among adjacent slots
|
||||||
|
(do ((sub-timeline new-timeline (cdr sub-timeline)))
|
||||||
|
((null (cdr sub-timeline)))
|
||||||
|
(let* ((entry-1 (first sub-timeline))
|
||||||
|
(entry-2 (second sub-timeline))
|
||||||
|
(end-1 (second entry-1))
|
||||||
|
(start-2 (first entry-2)))
|
||||||
|
(when (not (= end-1 start-2))
|
||||||
|
(let ((middle (/ (+ end-1 start-2) 2)))
|
||||||
|
(setf (second entry-1) middle)
|
||||||
|
(setf (first entry-2) middle)))))
|
||||||
|
new-timeline))
|
||||||
|
|
||||||
|
(defun db/org-get-headline (marker)
|
||||||
|
"Get headline of task at MARKER."
|
||||||
|
(assert (markerp marker))
|
||||||
|
(save-match-data
|
||||||
|
(let* ((heading (save-mark-and-excursion
|
||||||
|
(with-current-buffer (marker-buffer marker)
|
||||||
|
(goto-char (marker-position marker))
|
||||||
|
(thing-at-point 'line t)))))
|
||||||
|
(string-match (format "^\\(\\*+\\)\\(?: +%s\\)?\\(?: %s\\)? +\\(.*?\\)[ \t]*\\(?::\\(?:[A-Za-z_]+:\\)+\\)?$"
|
||||||
|
(regexp-opt org-todo-keywords-1)
|
||||||
|
org-priority-regexp)
|
||||||
|
heading)
|
||||||
|
(match-string 4 heading))))
|
||||||
|
|
||||||
|
(defcustom timeline-short-task-threshold 300
|
||||||
|
"Duration of task to be considered as short."
|
||||||
|
:group 'timeline-reporting
|
||||||
|
:type 'integer)
|
||||||
|
|
||||||
|
(defun db/org-format-timeline (tstart tend &optional files)
|
||||||
|
"Display timeline of tasks in FILES between TSTART and TEND.
|
||||||
|
When not given, FILES defaults to `org-agenda-files’. Short
|
||||||
|
slots are removed, and afterwards slots are clusted by category.
|
||||||
|
When called interactively, START and END are queried with
|
||||||
|
`org-read-date’."
|
||||||
|
(interactive (list (org-read-date nil nil nil "Start time: ")
|
||||||
|
(org-read-date nil nil nil "End time: ")))
|
||||||
|
(let ((timeline (->> (db/org-timeline-in-range tstart tend files)
|
||||||
|
(db/org-skip-short-entries-in-timeline
|
||||||
|
timeline-short-task-threshold)
|
||||||
|
db/org-cluster-timeline-same-category)))
|
||||||
|
(let ((target-buffer (get-buffer-create " *Org Timeline*")))
|
||||||
|
(with-current-buffer target-buffer
|
||||||
|
(erase-buffer)
|
||||||
|
(org-mode)
|
||||||
|
(insert "|--|\n")
|
||||||
|
(insert "| Category | Start | End | Duration | Task |\n")
|
||||||
|
(insert "|--|\n")
|
||||||
|
(dolist (cluster timeline)
|
||||||
|
(cl-destructuring-bind (start end markers) cluster
|
||||||
|
(insert (format "| %s | %s | %s | %s min | "
|
||||||
|
(org-entry-get (first markers) "CATEGORY")
|
||||||
|
(format-time-string "%Y-%m-%d %H:%M" start)
|
||||||
|
(format-time-string "%Y-%m-%d %H:%M" end)
|
||||||
|
(floor (/ (- end start) 60))))
|
||||||
|
;; insert headline line by line, but only once
|
||||||
|
(dolist (headline (->> (mapcar #'db/org-get-headline markers)
|
||||||
|
-uniq
|
||||||
|
(-interpose "|\n |||||")))
|
||||||
|
(insert headline))
|
||||||
|
(insert "\n")))
|
||||||
|
(insert "|--|\n")
|
||||||
|
(goto-char (point-min))
|
||||||
|
(org-table-align))
|
||||||
|
(display-buffer target-buffer)
|
||||||
|
t)))
|
||||||
|
|
||||||
|
(defun db/org-format-timeline-of-day (date &optional files)
|
||||||
|
"Format timeline of given DATE.
|
||||||
|
DATE should be a string of the form %Y-%m-%d. When called
|
||||||
|
interactively, this date will be queried with `org-read-date’.
|
||||||
|
The timeline will be formatted for DATE starting at 00:00 and
|
||||||
|
ending at 23:61. When not given, FILES defaults to
|
||||||
|
`org-agenda-files’."
|
||||||
|
(interactive (list (org-read-date nil nil)))
|
||||||
|
(db/org-format-timeline (concat date " 00:00")
|
||||||
|
(concat date " 23:61")
|
||||||
|
files))
|
||||||
|
|
||||||
|
|
||||||
|
;;; Manipulating Clock Lines
|
||||||
|
|
||||||
|
(defun db/org-insert-clockline (time-1 time-2)
|
||||||
|
"Insert new clock line from TIME-1 to TIME-2 at the beginning
|
||||||
|
of the current line. TIME-1 and TIME-2 must be given in a
|
||||||
|
format understandable by `format-time-string’, which see.
|
||||||
|
Saves mark and point."
|
||||||
|
(let ((timestamp-format (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")))
|
||||||
|
(save-mark-and-excursion
|
||||||
|
(beginning-of-line)
|
||||||
|
(indent-according-to-mode)
|
||||||
|
(insert "CLOCK: ")
|
||||||
|
(insert (format-time-string timestamp-format time-1))
|
||||||
|
(insert "--")
|
||||||
|
(insert (format-time-string timestamp-format time-2))
|
||||||
|
(org-clock-update-time-maybe))))
|
||||||
|
|
||||||
|
(defun db/org-add-clocking-time (starting-time ending-time)
|
||||||
|
"Add \"CLOCK:\" line to the task under point in the current org-mode file."
|
||||||
|
(interactive
|
||||||
|
(list (starting-time (org-read-date 4 'totime nil
|
||||||
|
"Start:" (current-time) nil t))
|
||||||
|
(ending-time (org-read-date 4 'totime nil
|
||||||
|
"End:" (current-time) nil t))))
|
||||||
|
(if (not (eq major-mode 'org-mode))
|
||||||
|
(user-error "Must be in org mode")
|
||||||
|
(save-mark-and-excursion
|
||||||
|
(org-clock-find-position nil)
|
||||||
|
(open-line 1)
|
||||||
|
(db/org-insert-clockline starting-time ending-time))))
|
||||||
|
|
||||||
|
(bind-key "C-c C-x C-a" #'db/org-add-clocking-time org-mode-map)
|
||||||
|
|
||||||
|
(defun db/org-add-clock-line-to-marker (target-marker start end)
|
||||||
|
"Add clock line with START and END time to task identified by TARGET-MARKER.
|
||||||
|
START and END must be given as time objects as returned by
|
||||||
|
`encode-time’, or as an integer or float denoting seconds since
|
||||||
|
1970-01-01. TARGET-MARKER must be positioned on the task where
|
||||||
|
the clock line is to be added to."
|
||||||
|
(when (not (markerp target-marker))
|
||||||
|
(user-error "Marker not valid."))
|
||||||
|
(let ((new-start (float-time start))
|
||||||
|
(new-end (float-time end)))
|
||||||
|
(with-current-buffer (marker-buffer target-marker)
|
||||||
|
(db/org-map-clock-lines-and-entries
|
||||||
|
(lambda (timestamp-1 timestamp-2)
|
||||||
|
(let ((current-start (float-time
|
||||||
|
(apply #'encode-time
|
||||||
|
(org-parse-time-string timestamp-1))))
|
||||||
|
(current-end (float-time
|
||||||
|
(apply #'encode-time
|
||||||
|
(org-parse-time-string timestamp-2))))
|
||||||
|
(kill-whole-line nil) ; don’t delete newlines if not asked to
|
||||||
|
)
|
||||||
|
(cond
|
||||||
|
;; if the current clock line is completely contained within the
|
||||||
|
;; given period, delete it
|
||||||
|
((and (<= new-start current-start current-end new-end))
|
||||||
|
(kill-whole-line))
|
||||||
|
;; if the current clock line completely contains the given one,
|
||||||
|
;; split it
|
||||||
|
((and (<= current-start new-start new-end current-end))
|
||||||
|
(beginning-of-line)
|
||||||
|
(kill-line)
|
||||||
|
(db/org-insert-clockline current-start new-start)
|
||||||
|
(open-line 1)
|
||||||
|
(db/org-insert-clockline new-end current-end))
|
||||||
|
;; New interval overlaps beginning of current line
|
||||||
|
((<= new-start current-start new-end current-end)
|
||||||
|
(beginning-of-line)
|
||||||
|
(kill-line)
|
||||||
|
(db/org-insert-clockline new-end current-end))
|
||||||
|
;; New interval overlaps at end of current line
|
||||||
|
((<= current-start new-start current-end new-end)
|
||||||
|
(beginning-of-line)
|
||||||
|
(kill-line)
|
||||||
|
(db/org-insert-clockline current-start new-start)))))
|
||||||
|
|
||||||
|
;; Keep headline as they are, i.e., do nothing
|
||||||
|
(lambda ())))
|
||||||
|
|
||||||
|
;; Finally add the new clock line
|
||||||
|
(org-with-point-at target-marker
|
||||||
|
(db/org-add-clocking-time new-start new-end))))
|
||||||
|
|
||||||
|
(defun db/org-clock-lines-of-task (marker)
|
||||||
|
"Return list of all clock lines of task under MARKER.
|
||||||
|
Each clock line is represented as a cons cell (START . END),
|
||||||
|
where both START and END are the starting and ending times of the
|
||||||
|
corresponding clock lines, encoded as a float denoting the
|
||||||
|
seconds since the epoch. Includes clock lines of all subtrees as
|
||||||
|
well. The order of the entries in the resulting list will be
|
||||||
|
reversed of what it is in the subtree of MARKER."
|
||||||
|
(when (not (markerp marker))
|
||||||
|
(user-error "Marker not valid."))
|
||||||
|
(let ((clock-lines nil))
|
||||||
|
(save-mark-and-excursion
|
||||||
|
(org-with-point-at marker
|
||||||
|
(org-narrow-to-subtree)
|
||||||
|
(db/org-map-clock-lines-and-entries
|
||||||
|
(lambda (start end)
|
||||||
|
(push (cons (org-time-string-to-seconds start)
|
||||||
|
(org-time-string-to-seconds end))
|
||||||
|
clock-lines))
|
||||||
|
(lambda ()))))
|
||||||
|
clock-lines))
|
||||||
|
|
||||||
|
(defun db/org-copy-clock-lines (source-id target-id)
|
||||||
|
"Copy clock lines from one task to another, adapting clock
|
||||||
|
lines in the file of TARGET-ID accordingly.
|
||||||
|
|
||||||
|
Both SOURCE-ID and TARGET-ID must designate known org-mode
|
||||||
|
tasks. Copies all clock lines attached to SOURCE-ID or to one of
|
||||||
|
its subtree."
|
||||||
|
(let ((source-marker (org-id-find source-id :get-marker))
|
||||||
|
(target-marker (org-id-find target-id :get-marker)))
|
||||||
|
(cl-assert (markerp source-marker)
|
||||||
|
"Source task %s not found" source-id)
|
||||||
|
(cl-assert (markerp target-marker)
|
||||||
|
"Target task %s not found" target-id)
|
||||||
|
|
||||||
|
;; We first fetch the relevant clock-lines into memory, and then add them to
|
||||||
|
;; the target task one by one, adjusting the other clock lines in between;
|
||||||
|
;; this is rather inefficient, but we will fix this only when we need it.
|
||||||
|
(dolist (clock-line (db/org-clock-lines-of-task source-marker))
|
||||||
|
(db/org-add-clock-line-to-marker target-marker
|
||||||
|
(car clock-line) (cdr clock-line)))))
|
||||||
|
|
||||||
|
(provide 'timeline-tools)
|
Loading…
Reference in New Issue