2018-01-21 18:28:36 +01:00
|
|
|
|
;;; timeline-tools.el -- Utilities to manipulate org-mode timelines -*- lexical-binding: t -*-
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-01-21 18:28:36 +01:00
|
|
|
|
;;; Commentary:
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-01-21 18:51:30 +01:00
|
|
|
|
;; XXX: give brief overview, explain nomenclature (timelines, clock-lines,
|
2018-02-19 10:41:43 +01:00
|
|
|
|
;; entries, ...), then list main functionality
|
|
|
|
|
|
2018-01-21 18:51:30 +01:00
|
|
|
|
;; XXX: This needs some tests
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-01-21 18:28:36 +01:00
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
(require 'dash)
|
|
|
|
|
(require 'org)
|
|
|
|
|
(require 'org-clock)
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-01-21 18:28:36 +01:00
|
|
|
|
|
|
|
|
|
;; Customization
|
|
|
|
|
|
|
|
|
|
(defgroup timeline-tools nil
|
|
|
|
|
"Functionality for manipulating timelines."
|
|
|
|
|
:tag "Timeline Tools"
|
2018-01-21 18:07:04 +01:00
|
|
|
|
:group 'applications)
|
|
|
|
|
|
2018-08-03 20:15:33 +02:00
|
|
|
|
(defcustom timeline-tools-filter-functions
|
|
|
|
|
(list #'timeline-tools-remove-short-entries #'timeline-tools-cluster-same-entry)
|
2018-01-21 19:15:33 +01:00
|
|
|
|
"List of functions to apply when formatting timelines.
|
|
|
|
|
Filter are applied in the order they are given in this list."
|
|
|
|
|
:group 'timeline-tools
|
|
|
|
|
:type '(list function))
|
|
|
|
|
|
2018-08-03 20:14:39 +02:00
|
|
|
|
(defcustom timeline-tools-short-task-threshold 300
|
|
|
|
|
"Duration of task to be considered as short."
|
|
|
|
|
:group 'timeline-tools
|
|
|
|
|
:type 'integer)
|
|
|
|
|
|
2018-04-30 19:30:24 +02:00
|
|
|
|
|
|
|
|
|
;; Mode definition
|
|
|
|
|
|
|
|
|
|
(defvar timeline-tools--current-time-start nil
|
|
|
|
|
"Current start time of the displayed timeline.")
|
|
|
|
|
|
|
|
|
|
(defvar timeline-tools--current-time-end nil
|
|
|
|
|
"Current end time of the displayed timeline.")
|
|
|
|
|
|
|
|
|
|
(defvar timeline-tools--current-files nil
|
|
|
|
|
"Files from which the current timeline has been extracted.")
|
|
|
|
|
|
|
|
|
|
(defvar timeline-tools--current-timeline nil
|
|
|
|
|
"Currently displayed timeline in abstract form.")
|
|
|
|
|
|
2018-07-31 14:12:49 +02:00
|
|
|
|
(defvar timeline-tools-headline-time-format "%Y-%m-%d %H:%M"
|
|
|
|
|
"Format of time used in the headline of a timeline.")
|
|
|
|
|
|
|
|
|
|
(defvar timeline-tools-time-format "%Y-%m-%d %H:%M"
|
|
|
|
|
"Format of time used inside a timeline")
|
|
|
|
|
|
2018-04-30 19:30:24 +02:00
|
|
|
|
(defvar timeline-tools-mode-map
|
|
|
|
|
(let ((map (make-sparse-keymap)))
|
|
|
|
|
(define-key map [remap self-insert-command] 'undefined)
|
|
|
|
|
(define-key map "r" #'timeline-tools-redraw-timeline)
|
2018-06-29 21:22:09 +02:00
|
|
|
|
(define-key map "R" #'timeline-tools-reparse-timeline)
|
2018-04-30 19:30:24 +02:00
|
|
|
|
(define-key map "f" #'timeline-tools-forward-day)
|
|
|
|
|
(define-key map "b" #'timeline-tools-backward-day)
|
2018-07-31 14:35:58 +02:00
|
|
|
|
(define-key map "s" #'timeline-tools-skip-short-entries)
|
2018-07-31 16:04:05 +02:00
|
|
|
|
(define-key map (kbd "RET") #'timeline-tools-jump-to-headline)
|
2018-06-29 21:21:50 +02:00
|
|
|
|
(define-key map "q" #'quit-window)
|
2018-04-30 19:30:24 +02:00
|
|
|
|
map))
|
|
|
|
|
|
|
|
|
|
(define-derived-mode timeline-tools-mode
|
|
|
|
|
org-mode "Timeline"
|
|
|
|
|
"Major mode to display org-mode timelines.")
|
|
|
|
|
|
2018-02-19 10:21:35 +01:00
|
|
|
|
|
|
|
|
|
;; Model
|
|
|
|
|
|
|
|
|
|
(defalias 'timeline-tools-entry-start-time 'car
|
|
|
|
|
"Start time of ENTRY.")
|
|
|
|
|
|
|
|
|
|
(defalias 'timeline-tools-entry-end-time 'cadr
|
|
|
|
|
"End time of ENTRY.")
|
|
|
|
|
|
2018-02-19 12:57:15 +01:00
|
|
|
|
(defalias 'timeline-tools-entry-markers 'caddr
|
2018-02-19 10:21:35 +01:00
|
|
|
|
"Marker to org task of ENTRY.")
|
|
|
|
|
|
2018-02-19 12:19:05 +01:00
|
|
|
|
(defun timeline-tools-make-entry (start-time end-time markers)
|
|
|
|
|
"Return a timeline entry made up of START-TIME, END-TIME, and MARKERS.
|
2018-02-19 12:58:50 +01:00
|
|
|
|
MARKER may be a list of markers, or a single marker. Duplicate
|
|
|
|
|
markers will only be kept once."
|
|
|
|
|
(list start-time end-time (if (listp markers) (-uniq markers) (list markers))))
|
|
|
|
|
|
|
|
|
|
(defun timeline-tools-entry-duration (entry)
|
|
|
|
|
"Returns the duration of ENTRY, in minutes."
|
|
|
|
|
(floor (/ (- (timeline-tools-entry-end-time entry)
|
|
|
|
|
(timeline-tools-entry-start-time entry))
|
|
|
|
|
60)))
|
2018-02-19 10:41:37 +01:00
|
|
|
|
|
|
|
|
|
(defun timeline-tools-entry-category (entry)
|
|
|
|
|
"Return ARCHIVE_CATEGORY or CATEGORY at position given by MARKER.
|
2018-02-19 12:57:15 +01:00
|
|
|
|
Return whatever is found first."
|
|
|
|
|
(let ((marker (car (timeline-tools-entry-markers entry))))
|
2018-02-19 10:41:37 +01:00
|
|
|
|
(or (org-entry-get marker "ARCHIVE_CATEGORY")
|
|
|
|
|
(org-entry-get marker "CATEGORY"))))
|
|
|
|
|
|
2018-02-19 12:58:50 +01:00
|
|
|
|
(defun timeline-tools-entry-headlines (entry)
|
2018-07-31 16:02:46 +02:00
|
|
|
|
"Return list of all headlines associated with ENTRY.
|
|
|
|
|
The headline will be a string, propertized with a property called
|
|
|
|
|
`marker’ and a corresponding marker pointing to the headline."
|
2018-02-19 12:58:50 +01:00
|
|
|
|
(mapcar (lambda (marker)
|
2018-07-31 16:02:46 +02:00
|
|
|
|
(let ((heading (org-with-point-at marker
|
|
|
|
|
(org-element-headline-parser (point-max)))))
|
|
|
|
|
(propertize (plist-get (cadr heading) :raw-value)
|
|
|
|
|
'marker marker)))
|
2018-02-19 12:58:50 +01:00
|
|
|
|
(timeline-tools-entry-markers entry)))
|
|
|
|
|
|
2018-01-21 18:28:36 +01:00
|
|
|
|
|
|
|
|
|
;; Utilities
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-01-21 18:47:11 +01:00
|
|
|
|
(defun timeline-tools-map-clocklines (clockline-fn headline-fn)
|
2018-01-21 18:07:04 +01:00
|
|
|
|
"Iterate point over all clocklines and headlines of the current buffer.
|
2018-01-21 18:28:36 +01:00
|
|
|
|
|
2018-01-21 18:07:04 +01:00
|
|
|
|
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)))))))))
|
|
|
|
|
|
2018-01-21 19:00:14 +01:00
|
|
|
|
(defvar timeline-tools-org-inactive-timestamp-format
|
|
|
|
|
(concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
|
|
|
|
|
"Format of inactive `org-mode’ timestamps.
|
2018-01-21 19:48:12 +01:00
|
|
|
|
Can be used as format string for `format-time’.")
|
2018-01-21 19:00:14 +01:00
|
|
|
|
|
2018-01-21 18:47:11 +01:00
|
|
|
|
(defun timeline-tools-insert-clockline (time-1 time-2)
|
|
|
|
|
"Insert new clock line from TIME-1 to TIME-2.
|
|
|
|
|
|
|
|
|
|
Insertion will be done 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."
|
2018-01-21 19:00:14 +01:00
|
|
|
|
(save-mark-and-excursion
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(indent-according-to-mode)
|
|
|
|
|
(insert "CLOCK: ")
|
|
|
|
|
(insert (format-time-string timeline-tools-org-inactive-timestamp-format
|
|
|
|
|
time-1))
|
|
|
|
|
(insert "--")
|
|
|
|
|
(insert (format-time-string timeline-tools-org-inactive-timestamp-format
|
|
|
|
|
time-2))
|
|
|
|
|
(org-clock-update-time-maybe)))
|
2018-01-21 18:47:11 +01:00
|
|
|
|
|
2018-01-21 18:51:30 +01:00
|
|
|
|
(defun timeline-tools-clocklines-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)
|
|
|
|
|
(timeline-tools-map-clocklines
|
|
|
|
|
(lambda (start end)
|
|
|
|
|
(push (cons (org-time-string-to-seconds start)
|
|
|
|
|
(org-time-string-to-seconds end))
|
|
|
|
|
clock-lines))
|
2018-01-21 19:04:10 +01:00
|
|
|
|
#'ignore)))
|
2018-01-21 18:51:30 +01:00
|
|
|
|
clock-lines))
|
|
|
|
|
|
2018-02-19 12:58:50 +01:00
|
|
|
|
(defun timeline-tools-format-entry-time (entry type)
|
|
|
|
|
"Return time of ENTRY of type TYPE formatted as string.
|
|
|
|
|
|
|
|
|
|
The format used is specified by the value of `timeline-tools-time-format’."
|
|
|
|
|
(format-time-string
|
|
|
|
|
timeline-tools-time-format
|
|
|
|
|
(cl-ecase type
|
|
|
|
|
((start) (timeline-tools-entry-start-time entry))
|
|
|
|
|
((end) (timeline-tools-entry-end-time entry)))))
|
|
|
|
|
|
2018-01-21 18:28:36 +01:00
|
|
|
|
|
|
|
|
|
;; Reporting
|
|
|
|
|
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(defun timeline-tools-clocklines-in-range (tstart tend)
|
2018-01-21 18:28:36 +01:00
|
|
|
|
"Return tasks in current buffer between TSTART and TEND.
|
|
|
|
|
|
|
|
|
|
The resulting list consists of elements of the form
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
|
|
|
|
(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
|
2018-07-31 14:07:20 +02:00
|
|
|
|
given as seconds since the epoch, as a floating point number.
|
|
|
|
|
Truncation with respect to TSTART and TEND is done, i.e., START
|
|
|
|
|
or END will always be in the interval [TSTART,TEND]."
|
2018-01-21 18:07:04 +01:00
|
|
|
|
;; 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)
|
2018-01-21 18:47:11 +01:00
|
|
|
|
(timeline-tools-map-clocklines
|
2018-01-21 18:07:04 +01:00
|
|
|
|
;; when on clock line, collect times
|
|
|
|
|
#'(lambda (start end)
|
2018-01-24 20:48:57 +01:00
|
|
|
|
(let* ((ts (org-time-string-to-seconds start))
|
|
|
|
|
(te (org-time-string-to-seconds end)))
|
|
|
|
|
(when (or (<= tstart te tend)
|
|
|
|
|
(<= tstart ts tend)
|
|
|
|
|
(<= ts tstart tend te))
|
2018-07-31 14:07:20 +02:00
|
|
|
|
(push (cons (max ts tstart)
|
|
|
|
|
(min te tend))
|
|
|
|
|
times))))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
;; when on headlines, store away collected clocklines
|
|
|
|
|
#'(lambda ()
|
2018-01-24 20:48:57 +01:00
|
|
|
|
;; add currently running clock if wanted
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(when (and org-clock-report-include-clocking-task
|
|
|
|
|
(eq (org-clocking-buffer) (current-buffer))
|
2018-01-24 21:05:11 +01:00
|
|
|
|
(eq (marker-position org-clock-hd-marker) (point)))
|
|
|
|
|
(let ((current-clock-start (float-time org-clock-start-time))
|
|
|
|
|
(current-clock-end (float-time)))
|
|
|
|
|
(when (or (<= tstart current-clock-start tend)
|
|
|
|
|
(<= tstart current-clock-end tend)
|
|
|
|
|
(<= current-clock-start
|
|
|
|
|
tstart tend
|
|
|
|
|
current-clock-end))
|
2018-07-31 14:07:20 +02:00
|
|
|
|
(push (cons (max current-clock-start tstart)
|
|
|
|
|
(min current-clock-end tend))
|
|
|
|
|
times))))
|
2018-01-24 20:48:57 +01:00
|
|
|
|
;; store away clocklines of current headline
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(when (not (null times))
|
|
|
|
|
(push (cons (point-marker) times) task-clock-times)
|
|
|
|
|
(setq times nil))))
|
|
|
|
|
task-clock-times)))
|
|
|
|
|
|
2018-01-21 18:47:11 +01:00
|
|
|
|
(defun timeline-tools-timeline (tstart tend &optional files)
|
2018-02-19 10:41:37 +01:00
|
|
|
|
"Return list of timeline entries between TSTART and TEND from FILES.
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-02-19 10:41:37 +01:00
|
|
|
|
Each entry consists of a START-TIME, END-TIME, and MARKER are as
|
|
|
|
|
returned by `timeline-tools-clocklines-in-range’, which see.
|
|
|
|
|
Entries in the resulting list are sorted by START, ascending. If
|
|
|
|
|
not given, FILES defaults to `org-agenda-files’ including all
|
|
|
|
|
archives."
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(let (timeline-of-files turned-around-timeline)
|
|
|
|
|
(setq timeline-of-files
|
2018-01-27 12:11:59 +01:00
|
|
|
|
(->> (or files (org-agenda-files t t))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(cl-remove-if-not #'file-exists-p)
|
|
|
|
|
(cl-mapcan #'(lambda (file)
|
|
|
|
|
(with-current-buffer (or (get-file-buffer file)
|
|
|
|
|
(find-file-noselect file))
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(timeline-tools-clocklines-in-range tstart tend))))))
|
2018-02-19 12:11:36 +01:00
|
|
|
|
;; collect clock-lines in timeline and convert them to proper entries
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(dolist (entry timeline-of-files)
|
|
|
|
|
(dolist (clock-time (cdr entry))
|
2018-02-19 10:41:37 +01:00
|
|
|
|
(push (timeline-tools-make-entry (car clock-time) (cdr clock-time) (car entry))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
turned-around-timeline)))
|
2018-02-19 12:11:36 +01:00
|
|
|
|
|
|
|
|
|
;; sort timeline
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(sort turned-around-timeline
|
|
|
|
|
(lambda (entry-1 entry-2)
|
2018-02-19 10:21:35 +01:00
|
|
|
|
(< (timeline-tools-entry-start-time entry-1)
|
|
|
|
|
(timeline-tools-entry-start-time entry-2))))))
|
|
|
|
|
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(defun timeline-tools-cluster-same-category (timeline)
|
2018-01-21 18:07:04 +01:00
|
|
|
|
"Cluster TIMELINE into consecutive entries with equal category.
|
|
|
|
|
Markers to org mode tasks are combined into a list."
|
2018-02-19 10:41:37 +01:00
|
|
|
|
(let ((new-timeline (-partition-by #'timeline-tools-entry-category timeline)))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(mapcar (lambda (cluster)
|
2018-02-19 12:19:05 +01:00
|
|
|
|
(timeline-tools-make-entry
|
|
|
|
|
(timeline-tools-entry-start-time (-first-item cluster))
|
|
|
|
|
(timeline-tools-entry-end-time (-last-item cluster))
|
2018-02-19 12:57:15 +01:00
|
|
|
|
(-mapcat #'timeline-tools-entry-markers cluster)))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
new-timeline)))
|
|
|
|
|
|
2018-08-03 20:14:57 +02:00
|
|
|
|
(defun timeline-tools-cluster-same-entry (timeline)
|
|
|
|
|
"Cluster TIMELINE into consecutive entries with equal marker.
|
|
|
|
|
This only works if every entry in timeline consists of a
|
|
|
|
|
singleton marker only. In case this is not satisfied, this
|
|
|
|
|
function will throw an error."
|
|
|
|
|
(assert (-all-p #'(lambda (entry)
|
|
|
|
|
(null (cdr (timeline-tools-entry-markers entry))))
|
|
|
|
|
timeline)
|
|
|
|
|
"Timeline must not contain entries with more than one marker.")
|
|
|
|
|
(let ((new-timeline (-partition-by #'(lambda (entry)
|
|
|
|
|
(-first-item (timeline-tools-entry-markers entry)))
|
|
|
|
|
timeline)))
|
|
|
|
|
(mapcar (lambda (cluster)
|
|
|
|
|
(timeline-tools-make-entry
|
|
|
|
|
(timeline-tools-entry-start-time (-first-item cluster))
|
|
|
|
|
(timeline-tools-entry-end-time (-last-item cluster))
|
|
|
|
|
(-mapcat #'timeline-tools-entry-markers cluster)))
|
|
|
|
|
new-timeline)))
|
|
|
|
|
|
2018-07-31 14:35:58 +02:00
|
|
|
|
(defun timeline-tools-remove-short-entries (timeline &optional threshold)
|
|
|
|
|
"Remove entries from TIMELINE shorter than THRESHOLD.
|
2018-01-21 18:28:36 +01:00
|
|
|
|
|
2018-01-21 18:07:04 +01:00
|
|
|
|
A slot is short if it is not longer than THRESHOLD seconds.
|
2018-07-31 14:35:58 +02:00
|
|
|
|
Resulting gaps are distributed evenly among adjacent slots.
|
2018-08-03 20:14:39 +02:00
|
|
|
|
THRESHOLD defaults to the value of
|
|
|
|
|
`timeline-tools-short-task-threshold’ if not supplied."
|
2018-02-19 10:21:35 +01:00
|
|
|
|
(let ((start (timeline-tools-entry-start-time (-first-item timeline)))
|
|
|
|
|
(end (timeline-tools-entry-end-time (-last-item timeline)))
|
2018-08-03 20:14:39 +02:00
|
|
|
|
(threshold (or threshold timeline-tools-short-task-threshold))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
new-timeline)
|
2018-02-19 10:21:35 +01:00
|
|
|
|
|
2018-01-21 18:07:04 +01:00
|
|
|
|
;; remove all slots that are too short
|
|
|
|
|
(setq new-timeline
|
|
|
|
|
(cl-remove-if (lambda (entry)
|
2018-02-19 10:21:35 +01:00
|
|
|
|
(<= (- (timeline-tools-entry-end-time entry)
|
|
|
|
|
(timeline-tools-entry-start-time entry))
|
2018-07-31 14:35:58 +02:00
|
|
|
|
threshold))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
timeline))
|
|
|
|
|
|
|
|
|
|
;; reset start and end times
|
2018-02-19 10:21:35 +01:00
|
|
|
|
(setf (timeline-tools-entry-start-time (-first-item new-timeline)) start)
|
|
|
|
|
(setf (timeline-tools-entry-end-time (-last-item new-timeline)) end)
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
|
|
|
|
;; distribute gaps evenly among adjacent slots
|
2018-01-24 20:50:04 +01:00
|
|
|
|
(cl-do
|
|
|
|
|
((sub-timeline new-timeline (cdr sub-timeline)))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
((null (cdr sub-timeline)))
|
2018-02-19 10:21:35 +01:00
|
|
|
|
(let* ((entry-1 (-first-item sub-timeline))
|
|
|
|
|
(entry-2 (-second-item sub-timeline))
|
|
|
|
|
(end-1 (timeline-tools-entry-end-time entry-1))
|
|
|
|
|
(start-2 (timeline-tools-entry-start-time entry-2)))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(when (not (= end-1 start-2))
|
|
|
|
|
(let ((middle (/ (+ end-1 start-2) 2)))
|
2018-02-19 10:21:35 +01:00
|
|
|
|
(setf (timeline-tools-entry-end-time entry-1) middle)
|
|
|
|
|
(setf (timeline-tools-entry-start-time entry-2) middle)))))
|
|
|
|
|
|
2018-01-21 18:07:04 +01:00
|
|
|
|
new-timeline))
|
|
|
|
|
|
2018-04-30 19:30:24 +02:00
|
|
|
|
(defun timeline-tools-get-transformed-timeline (tstart tend files)
|
|
|
|
|
"Return timeline from files, after application of `timeline-tools-filter-functions’."
|
|
|
|
|
(let ((plain-timeline (timeline-tools-timeline tstart tend files)))
|
|
|
|
|
(and plain-timeline
|
|
|
|
|
(-reduce-from (lambda (tl f)
|
|
|
|
|
(funcall f tl))
|
|
|
|
|
plain-timeline
|
|
|
|
|
timeline-tools-filter-functions))))
|
|
|
|
|
|
2018-01-21 18:47:11 +01:00
|
|
|
|
;;;###autoload
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(defun timeline-tools-format-timeline (tstart tend &optional files)
|
2018-01-21 18:28:36 +01:00
|
|
|
|
"Display timeline of tasks between TSTART and TEND from FILES.
|
|
|
|
|
|
2018-01-27 12:11:59 +01:00
|
|
|
|
When not given, FILES defaults to `org-agenda-files’ including
|
2018-04-30 19:30:24 +02:00
|
|
|
|
archives. The timeline is transformed as given by the current
|
|
|
|
|
value of `timeline-tools-filter-functions’. When called
|
|
|
|
|
interactively, START and END are queried with `org-read-date’."
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(interactive (list (org-read-date nil nil nil "Start time: ")
|
|
|
|
|
(org-read-date nil nil nil "End time: ")))
|
2018-04-30 19:30:24 +02:00
|
|
|
|
(let* ((timeline (timeline-tools-get-transformed-timeline tstart tend files)))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(let ((target-buffer (get-buffer-create " *Org Timeline*")))
|
|
|
|
|
(with-current-buffer target-buffer
|
2018-04-30 19:30:24 +02:00
|
|
|
|
(timeline-tools-mode)
|
|
|
|
|
(setq-local timeline-tools--current-time-start (org-time-string-to-seconds tstart))
|
|
|
|
|
(setq-local timeline-tools--current-time-end (org-time-string-to-seconds tend))
|
|
|
|
|
(setq-local timeline-tools--current-files files)
|
|
|
|
|
(setq-local timeline-tools--current-timeline timeline)
|
2018-07-31 14:07:56 +02:00
|
|
|
|
(setq-local timeline-tools-time-format timeline-tools-time-format)
|
|
|
|
|
(setq-local timeline-tools-headline-time-format timeline-tools-headline-time-format)
|
2018-04-30 16:55:58 +02:00
|
|
|
|
(hl-line-mode)
|
2018-04-30 19:30:24 +02:00
|
|
|
|
(buffer-enable-undo)
|
|
|
|
|
(timeline-tools-redraw-timeline))
|
2018-04-30 16:55:58 +02:00
|
|
|
|
(pop-to-buffer target-buffer)
|
2018-01-21 18:07:04 +01:00
|
|
|
|
t)))
|
|
|
|
|
|
2018-01-21 18:47:11 +01:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun timeline-tools-format-timeline-of-day (date &optional files)
|
2018-01-21 18:07:04 +01:00
|
|
|
|
"Format timeline of given DATE.
|
2018-01-21 18:38:22 +01:00
|
|
|
|
|
2018-01-21 18:07:04 +01:00
|
|
|
|
DATE should be a string of the form %Y-%m-%d. When called
|
|
|
|
|
interactively, this date will be queried with `org-read-date’.
|
2018-07-31 14:10:12 +02:00
|
|
|
|
When not given, FILES defaults to `org-agenda-files’ including
|
|
|
|
|
archives."
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(interactive (list (org-read-date nil nil)))
|
2018-07-31 14:10:12 +02:00
|
|
|
|
(let ((timeline-tools-time-format "%H:%M")
|
|
|
|
|
(timeline-tools-headline-time-format "%Y-%m-%d"))
|
|
|
|
|
(timeline-tools-format-timeline (concat date " 00:00")
|
2018-08-03 18:39:56 +02:00
|
|
|
|
(org-read-date nil nil "++1d" nil
|
2018-07-31 14:10:12 +02:00
|
|
|
|
(org-time-string-to-time date))
|
|
|
|
|
files)))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-04-30 19:30:24 +02:00
|
|
|
|
|
|
|
|
|
;; Interactive functions
|
|
|
|
|
|
|
|
|
|
(defun timeline-tools-redraw-timeline ()
|
|
|
|
|
"Redraw timeline of current buffer"
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (not (eq major-mode 'timeline-tools-mode))
|
|
|
|
|
(user-error "Not in Timeline buffer")
|
|
|
|
|
(let ((timeline timeline-tools--current-timeline))
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(insert (format "* Timeline from [%s] to [%s]\n\n"
|
2018-07-31 14:07:56 +02:00
|
|
|
|
(format-time-string timeline-tools-headline-time-format
|
2018-04-30 19:30:24 +02:00
|
|
|
|
timeline-tools--current-time-start)
|
2018-07-31 14:07:56 +02:00
|
|
|
|
(format-time-string timeline-tools-headline-time-format
|
2018-04-30 19:30:24 +02:00
|
|
|
|
timeline-tools--current-time-end)))
|
|
|
|
|
(insert "|--|\n")
|
|
|
|
|
(insert "| Category | Start | End | Duration | Task |\n")
|
2018-07-31 14:09:56 +02:00
|
|
|
|
(let ((last-category nil))
|
|
|
|
|
(dolist (cluster timeline)
|
|
|
|
|
(when (not (equal last-category (timeline-tools-entry-category cluster)))
|
|
|
|
|
(insert "|--|\n")
|
|
|
|
|
(setq last-category (timeline-tools-entry-category cluster)))
|
|
|
|
|
(insert (format "| %s | %s | %s | %s min | "
|
2018-07-31 16:04:20 +02:00
|
|
|
|
(timeline-tools-entry-category cluster)
|
|
|
|
|
(timeline-tools-format-entry-time cluster 'start)
|
|
|
|
|
(timeline-tools-format-entry-time cluster 'end)
|
|
|
|
|
(timeline-tools-entry-duration cluster)))
|
|
|
|
|
;; insert headline line by line
|
2018-07-31 14:09:56 +02:00
|
|
|
|
(dolist (headline (-interpose "|\n |||||"
|
|
|
|
|
(timeline-tools-entry-headlines cluster)))
|
|
|
|
|
(insert headline))
|
|
|
|
|
(insert "\n")))
|
2018-04-30 19:30:24 +02:00
|
|
|
|
(insert "|--|\n")
|
|
|
|
|
(org-table-align)
|
|
|
|
|
(goto-char (point-min)))))
|
|
|
|
|
|
2018-06-29 21:22:09 +02:00
|
|
|
|
(defun timeline-tools-reparse-timeline ()
|
|
|
|
|
"Parse timeline from files again and redraws current display
|
|
|
|
|
Updates category properties before constructing the new timeline."
|
|
|
|
|
(interactive)
|
|
|
|
|
(dolist (file timeline-tools--current-files)
|
|
|
|
|
(with-current-buffer (get-file-buffer file)
|
|
|
|
|
(org-refresh-category-properties)))
|
|
|
|
|
(setq-local timeline-tools--current-timeline
|
|
|
|
|
(timeline-tools-get-transformed-timeline
|
|
|
|
|
timeline-tools--current-time-start
|
|
|
|
|
timeline-tools--current-time-end
|
|
|
|
|
timeline-tools--current-files))
|
|
|
|
|
(timeline-tools-redraw-timeline))
|
|
|
|
|
|
2018-04-30 19:30:24 +02:00
|
|
|
|
(defun timeline-tools-forward-day ()
|
|
|
|
|
"Display timeline of next day."
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (not (eq major-mode 'timeline-tools-mode))
|
|
|
|
|
(user-error "Not in Timeline buffer")
|
|
|
|
|
(setq-local timeline-tools--current-time-start (+ 86400 timeline-tools--current-time-start))
|
|
|
|
|
(setq-local timeline-tools--current-time-end (+ 86400 timeline-tools--current-time-end))
|
|
|
|
|
(setq-local timeline-tools--current-timeline
|
|
|
|
|
(timeline-tools-get-transformed-timeline
|
|
|
|
|
timeline-tools--current-time-start
|
|
|
|
|
timeline-tools--current-time-end
|
|
|
|
|
timeline-tools--current-files))
|
|
|
|
|
(timeline-tools-redraw-timeline)))
|
|
|
|
|
|
|
|
|
|
(defun timeline-tools-backward-day ()
|
|
|
|
|
"Display timeline of next day."
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (not (eq major-mode 'timeline-tools-mode))
|
|
|
|
|
(user-error "Not in Timeline buffer")
|
|
|
|
|
(setq-local timeline-tools--current-time-start
|
|
|
|
|
(- timeline-tools--current-time-start 86400))
|
|
|
|
|
(setq-local timeline-tools--current-time-end
|
|
|
|
|
(- timeline-tools--current-time-end 86400))
|
|
|
|
|
(setq-local timeline-tools--current-timeline
|
|
|
|
|
(timeline-tools-get-transformed-timeline
|
|
|
|
|
timeline-tools--current-time-start
|
|
|
|
|
timeline-tools--current-time-end
|
|
|
|
|
timeline-tools--current-files))
|
|
|
|
|
(timeline-tools-redraw-timeline)))
|
|
|
|
|
|
2018-07-31 14:35:58 +02:00
|
|
|
|
(defun timeline-tools-skip-short-entries ()
|
|
|
|
|
"Skip entries in current timeline that are too short.
|
|
|
|
|
Interactively query for the exact value of \"short\"."
|
|
|
|
|
(interactive)
|
|
|
|
|
(when (not (eq major-mode 'timeline-tools-mode))
|
|
|
|
|
(user-error "Not in Timeline buffer"))
|
|
|
|
|
(let ((threshold (string-to-number
|
|
|
|
|
(read-from-minibuffer "Maximum time for short entries (in seconds): "))))
|
|
|
|
|
(setq-local timeline-tools--current-timeline
|
2018-07-31 16:04:20 +02:00
|
|
|
|
(timeline-tools-remove-short-entries
|
|
|
|
|
timeline-tools--current-timeline threshold))
|
2018-07-31 14:35:58 +02:00
|
|
|
|
(timeline-tools-redraw-timeline)))
|
|
|
|
|
|
2018-07-31 16:04:05 +02:00
|
|
|
|
(defun timeline-tools-jump-to-headline ()
|
|
|
|
|
"Jump to headline of current entry, if available."
|
|
|
|
|
(interactive)
|
|
|
|
|
(unless (eq major-mode 'timeline-tools-mode)
|
|
|
|
|
(user-error "Not in Timeline buffer"))
|
|
|
|
|
(let ((marker (save-mark-and-excursion
|
|
|
|
|
(end-of-line)
|
|
|
|
|
(org-table-previous-field)
|
|
|
|
|
(get-text-property (point) 'marker))))
|
|
|
|
|
(unless marker
|
|
|
|
|
(user-error "Not on headline to jump to"))
|
|
|
|
|
(switch-to-buffer (marker-buffer marker))
|
|
|
|
|
(goto-char marker)
|
|
|
|
|
(org-reveal)))
|
|
|
|
|
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-01-21 18:51:30 +01:00
|
|
|
|
;;; Manipulating Clocklines
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(defun timeline-tools-add-clockline-to-marker (target-marker start end)
|
2018-01-21 18:28:36 +01:00
|
|
|
|
"Add clock line to task under TARGET-MARKER from START to END.
|
|
|
|
|
|
2018-01-21 18:07:04 +01:00
|
|
|
|
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))
|
2018-01-21 18:28:36 +01:00
|
|
|
|
(user-error "Marker not valid"))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(let ((new-start (float-time start))
|
|
|
|
|
(new-end (float-time end)))
|
|
|
|
|
(with-current-buffer (marker-buffer target-marker)
|
2018-01-21 18:47:11 +01:00
|
|
|
|
(timeline-tools-map-clocklines
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(lambda (timestamp-1 timestamp-2)
|
2018-01-24 20:54:48 +01:00
|
|
|
|
(let ((current-start (org-time-string-to-seconds timestamp-1))
|
|
|
|
|
(current-end (org-time-string-to-seconds timestamp-2))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(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)
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(timeline-tools-insert-clockline current-start new-start)
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(open-line 1)
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(timeline-tools-insert-clockline new-end current-end))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
;; New interval overlaps beginning of current line
|
|
|
|
|
((<= new-start current-start new-end current-end)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(kill-line)
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(timeline-tools-insert-clockline new-end current-end))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
;; New interval overlaps at end of current line
|
|
|
|
|
((<= current-start new-start current-end new-end)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(kill-line)
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(timeline-tools-insert-clockline current-start new-start)))))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
|
|
|
|
;; Keep headline as they are, i.e., do nothing
|
2018-01-21 19:04:10 +01:00
|
|
|
|
#'ignore))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
|
|
|
|
;; Finally add the new clock line
|
|
|
|
|
(org-with-point-at target-marker
|
2018-01-21 18:47:11 +01:00
|
|
|
|
(org-clock-find-position nil)
|
|
|
|
|
(open-line 1)
|
|
|
|
|
(timeline-tools-insert-clockline new-start new-end))))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(defun timeline-tools-copy-clocklines (source-id target-id)
|
2018-01-21 18:28:36 +01:00
|
|
|
|
"Copy clock lines from SOURCE-ID to TARGET-ID.
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-01-21 18:28:36 +01:00
|
|
|
|
Both SOURCE-ID and TARGET-ID must designate known `org-mode’
|
|
|
|
|
tasks by their ID. Copies all clock lines attached to SOURCE-ID
|
|
|
|
|
or to one of its subtree, and adapts the clock lines in the file
|
|
|
|
|
of TARGET-ID accordingly."
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(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.
|
2018-01-21 18:38:22 +01:00
|
|
|
|
(dolist (clock-line (timeline-tools-clocklines-of-task source-marker))
|
|
|
|
|
(timeline-tools-add-clockline-to-marker target-marker
|
2018-02-19 10:21:42 +01:00
|
|
|
|
(car clock-line) (cdr clock-line)))))
|
2018-01-21 18:07:04 +01:00
|
|
|
|
|
2018-01-21 18:47:11 +01:00
|
|
|
|
;; XXX: This needs some autoloadable frontend
|
|
|
|
|
|
2018-01-21 18:07:04 +01:00
|
|
|
|
(provide 'timeline-tools)
|
2018-01-21 18:28:36 +01:00
|
|
|
|
;;; timeline-tools.el ends here
|