|
|
;;; timeline-tools.el -- Utilities to manipulate org-mode timelines -*- lexical-binding: t -*-
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
;; This package is a home-grown solution for displaying easily readable
|
|
|
;; overviews of the clock times in my org-agenda files. I find the display
|
|
|
;; easier to read than the clock entries as shown in the agenda with log mode
|
|
|
;; enabled. Some additional editing functions help my with bringing the
|
|
|
;; displayed timelines into the shape as required for work.
|
|
|
|
|
|
;; The main entry point to this package is
|
|
|
;; `timeline-tools-format-timeline-of-day’, which when called interactively
|
|
|
;; queries for a date to display, and then formats all clocked times in a nicely
|
|
|
;; aligned org-mode table. Navigation in these tables as well as going forward
|
|
|
;; and backward by day are implemented as shortcuts; see the mode description
|
|
|
;; for more. The clock times are assumed to be non-overlapping, i.e., no point
|
|
|
;; in time is contained in the clock of more than one entry.
|
|
|
|
|
|
;; The main data structures used in this package are as follows:
|
|
|
;;
|
|
|
;; - Timelines: these are lists of entries (see next).
|
|
|
;; - Timeline Entries: structures consisting of start times,
|
|
|
;; end times, durations, headlines, and categories.
|
|
|
;;
|
|
|
;; To retrieve data from timeline entries, corresponding functions are provided.
|
|
|
|
|
|
;; XXX: talk about the way the timeline is generated
|
|
|
;; XXX: talk about filters
|
|
|
;; XXX: This needs some tests
|
|
|
;; XXX: timelines should have some metadata on their own (start time, end time,
|
|
|
;; files)
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
(require 'dash)
|
|
|
(require 'org)
|
|
|
(require 'org-clock)
|
|
|
(require 'org-id)
|
|
|
(require 'org-element)
|
|
|
|
|
|
|
|
|
;; Customization
|
|
|
|
|
|
(defgroup timeline-tools nil
|
|
|
"Functionality for manipulating timelines."
|
|
|
:tag "Timeline Tools"
|
|
|
:group 'applications)
|
|
|
|
|
|
(defcustom timeline-tools-filter-functions
|
|
|
(list #'timeline-tools-fill-gaps
|
|
|
#'timeline-tools-cluster-same-entries)
|
|
|
"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))
|
|
|
|
|
|
(defcustom timeline-tools-short-task-threshold 300
|
|
|
"Duration of task to be considered as short."
|
|
|
:group 'timeline-tools
|
|
|
:type 'integer)
|
|
|
|
|
|
(defcustom timeline-tools-headline-time-format "%Y-%m-%d %H:%M"
|
|
|
"Format of time used in the headline of a timeline."
|
|
|
:group 'timeline-tools
|
|
|
:type 'string)
|
|
|
|
|
|
(defcustom timeline-tools-time-format "%Y-%m-%d %H:%M"
|
|
|
"Format of time used inside a timeline."
|
|
|
:group 'timeline-tools
|
|
|
:type 'string)
|
|
|
|
|
|
(defcustom timeline-tools-category-function 'timeline-tools-entry-category
|
|
|
"Function for extracting the category of an entry when formatting a timeline.
|
|
|
|
|
|
This function is supposed to return a string representing the
|
|
|
category of a timeline entry, as it is used when formatting the
|
|
|
timeline with `timeline-tools-redraw-timeline’. It receives
|
|
|
three arguments, namly the entry itself, the start date, and the
|
|
|
end date of the timeline."
|
|
|
:group 'timeline-tools
|
|
|
:type 'function)
|
|
|
|
|
|
|
|
|
;; 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-mode-map
|
|
|
(let ((map (make-sparse-keymap)))
|
|
|
(define-key map [remap self-insert-command] 'undefined)
|
|
|
(define-key map "r" #'timeline-tools-redraw-timeline)
|
|
|
(define-key map "g" #'timeline-tools-redraw-timeline)
|
|
|
(define-key map "R" #'timeline-tools-reparse-timeline)
|
|
|
(define-key map "f" #'timeline-tools-forward-day)
|
|
|
(define-key map "b" #'timeline-tools-backward-day)
|
|
|
(define-key map (kbd "RET") #'timeline-tools-jump-to-headline)
|
|
|
(define-key map "q" #'quit-window)
|
|
|
(define-key map (kbd "C-k") #'timeline-tools-kill-line)
|
|
|
(define-key map "k" #'timeline-tools-kill-line)
|
|
|
(define-key map (kbd "C-n") #'timeline-tools-next-line)
|
|
|
(define-key map "n" #'timeline-tools-next-line)
|
|
|
(define-key map (kbd "C-p") #'timeline-tools-previous-line)
|
|
|
(define-key map "p" #'timeline-tools-previous-line)
|
|
|
map))
|
|
|
|
|
|
(define-derived-mode timeline-tools-mode
|
|
|
org-mode "Timeline"
|
|
|
"Major mode to display org-mode timelines."
|
|
|
(hl-line-mode)
|
|
|
(buffer-enable-undo))
|
|
|
|
|
|
|
|
|
;; Model
|
|
|
|
|
|
(defun timeline-tools-entry-start-time (entry)
|
|
|
"Start time of ENTRY."
|
|
|
(car entry))
|
|
|
|
|
|
(defun timeline-tools-entry-end-time (entry)
|
|
|
"End time of ENTRY."
|
|
|
(cadr entry))
|
|
|
|
|
|
(defun timeline-tools-entry-marker (entry)
|
|
|
"Marker to org task of ENTRY."
|
|
|
(caddr entry))
|
|
|
|
|
|
(gv-define-setter timeline-tools-entry-start-time
|
|
|
(time entry) `(setcar ,entry ,time))
|
|
|
(gv-define-setter timeline-tools-entry-end-time
|
|
|
(time entry) `(setcar (cdr ,entry) ,time))
|
|
|
|
|
|
(defun timeline-tools-make-entry (start-time end-time marker)
|
|
|
"Return a timeline entry made up of START-TIME, END-TIME, and MARKER.
|
|
|
MARKER must be a single marker."
|
|
|
(unless (markerp marker)
|
|
|
(user-error "No marker given"))
|
|
|
(list start-time end-time marker))
|
|
|
|
|
|
(defun timeline-tools-entry-duration (entry)
|
|
|
"Return the duration of ENTRY, in minutes."
|
|
|
(floor (/ (- (timeline-tools-entry-end-time entry)
|
|
|
(timeline-tools-entry-start-time entry))
|
|
|
60)))
|
|
|
|
|
|
(defun timeline-tools-entry-category (entry &rest _)
|
|
|
"Return ARCHIVE_CATEGORY or CATEGORY at position given by marker of ENTRY.
|
|
|
Return whatever is found first."
|
|
|
(let ((marker (timeline-tools-entry-marker entry)))
|
|
|
(or (org-entry-get marker "ARCHIVE_CATEGORY")
|
|
|
(org-entry-get marker "CATEGORY"))))
|
|
|
|
|
|
(defun timeline-tools-entry-headline (entry)
|
|
|
"Return the headline associated with ENTRY."
|
|
|
(let* ((marker (timeline-tools-entry-marker entry)))
|
|
|
(plist-get (cadr (org-with-point-at marker
|
|
|
(org-element-headline-parser (point-max))))
|
|
|
:raw-value)))
|
|
|
|
|
|
|
|
|
;; Utilities
|
|
|
|
|
|
(defun timeline-tools-map-clocklines (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. If either CLOCKLINE-FN or HEADLINE-FN
|
|
|
edit the current buffer, make sure to use `org-show-all' to show
|
|
|
all insivible elements; otherwise editing may result in
|
|
|
unpredictable behavior."
|
|
|
(unless (eq major-mode 'org-mode)
|
|
|
(user-error "Not in Org mode buffer, cannot parse clocklines"))
|
|
|
|
|
|
(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))))))))
|
|
|
|
|
|
(defvar timeline-tools-org-inactive-timestamp-format
|
|
|
(concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
|
|
|
"Format of inactive `org-mode’ timestamps.
|
|
|
Can be used as format string for `format-time’.")
|
|
|
|
|
|
(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. If
|
|
|
TIME-2 is nil, insert dangling clock line."
|
|
|
(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))
|
|
|
(unless (null time-2)
|
|
|
(insert "--")
|
|
|
(insert (format-time-string timeline-tools-org-inactive-timestamp-format
|
|
|
time-2))
|
|
|
(org-clock-update-time-maybe))))
|
|
|
|
|
|
(defun timeline-tools-clocklines-of-task (pom)
|
|
|
"Return list of all clock lines of task under POM.
|
|
|
|
|
|
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 POM."
|
|
|
(let ((clock-lines nil))
|
|
|
(save-mark-and-excursion
|
|
|
(org-with-point-at pom
|
|
|
(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))
|
|
|
#'ignore)))
|
|
|
clock-lines))
|
|
|
|
|
|
(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)))))
|
|
|
|
|
|
|
|
|
;; Reporting
|
|
|
|
|
|
(defun timeline-tools-clocklines-in-range (tstart tend)
|
|
|
"Return tasks in current buffer 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.
|
|
|
Truncation with respect to TSTART and TEND is done, i.e., START
|
|
|
or END will always be in the interval [TSTART,TEND]."
|
|
|
;; adapted from `org-clock-sum’
|
|
|
(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)
|
|
|
(timeline-tools-map-clocklines
|
|
|
;; when on clock line, collect times
|
|
|
#'(lambda (start end)
|
|
|
(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))
|
|
|
(push (cons (max ts tstart)
|
|
|
(min te tend))
|
|
|
times))))
|
|
|
;; when on headlines, store away collected clocklines
|
|
|
#'(lambda ()
|
|
|
;; add currently running clock if wanted
|
|
|
(when (and org-clock-report-include-clocking-task
|
|
|
(eq (org-clocking-buffer) (current-buffer))
|
|
|
(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))
|
|
|
(push (cons (max current-clock-start tstart)
|
|
|
(min current-clock-end tend))
|
|
|
times))))
|
|
|
;; store away clocklines of current headline
|
|
|
(when (not (null times))
|
|
|
(push (cons (point-marker) times) task-clock-times)
|
|
|
(setq times nil))))
|
|
|
task-clock-times))
|
|
|
|
|
|
(defun timeline-tools-timeline (tstart tend &optional files-or-buffers)
|
|
|
"Return timeline between TSTART and TEND from FILES-OR-BUFFERS.
|
|
|
|
|
|
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.
|
|
|
TSTART and TEND must be valid time specifiers for
|
|
|
`timeline-tools-clocklines-in-range’. If not given,
|
|
|
FILES-OR-BUFFERS defaults to `org-agenda-files’ including all
|
|
|
archives."
|
|
|
(let (timeline-of-files turned-around-timeline)
|
|
|
(setq timeline-of-files
|
|
|
(->> (or files-or-buffers (org-agenda-files t t))
|
|
|
(cl-mapcan #'(lambda (file-or-buffer)
|
|
|
(let ((buffer (cond
|
|
|
((bufferp file-or-buffer)
|
|
|
file-or-buffer)
|
|
|
((not (stringp file-or-buffer))
|
|
|
(warn "Neither valid file nor buffer: %s" file-or-buffer)
|
|
|
nil)
|
|
|
((not (file-exists-p file-or-buffer))
|
|
|
(warn "File does not exist: %s" file-or-buffer)
|
|
|
nil)
|
|
|
(t (or (get-file-buffer file-or-buffer)
|
|
|
(find-file-noselect file-or-buffer))))))
|
|
|
(when buffer
|
|
|
(with-current-buffer buffer
|
|
|
(timeline-tools-clocklines-in-range tstart tend))))))))
|
|
|
|
|
|
;; collect clock-lines in timeline and convert them to proper entries
|
|
|
(dolist (entry timeline-of-files)
|
|
|
(dolist (clock-time (cdr entry))
|
|
|
(push (timeline-tools-make-entry (car clock-time) (cdr clock-time) (car entry))
|
|
|
turned-around-timeline)))
|
|
|
|
|
|
;; sort timeline
|
|
|
(sort turned-around-timeline
|
|
|
(lambda (entry-1 entry-2)
|
|
|
(< (timeline-tools-entry-start-time entry-1)
|
|
|
(timeline-tools-entry-start-time entry-2))))))
|
|
|
|
|
|
(defun timeline-tools-cluster-same-entries (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."
|
|
|
(let ((new-timeline (-partition-by #'(lambda (entry)
|
|
|
(timeline-tools-entry-marker 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))
|
|
|
(timeline-tools-entry-marker (-first-item cluster))))
|
|
|
new-timeline)))
|
|
|
|
|
|
(defun timeline-tools-remove-short-entries (timeline &optional threshold)
|
|
|
"Remove entries from TIMELINE shorter than THRESHOLD.
|
|
|
|
|
|
A slot is short if it is not longer than THRESHOLD seconds.
|
|
|
Resulting gaps are distributed evenly among adjacent slots.
|
|
|
THRESHOLD defaults to the value of
|
|
|
`timeline-tools-short-task-threshold’ if not supplied.
|
|
|
|
|
|
This function destructively modifies its first argument."
|
|
|
(unless (null timeline)
|
|
|
(let ((start (timeline-tools-entry-start-time (-first-item timeline)))
|
|
|
(end (timeline-tools-entry-end-time (-last-item timeline)))
|
|
|
(threshold (or threshold timeline-tools-short-task-threshold))
|
|
|
new-timeline)
|
|
|
|
|
|
;; remove all slots that are too short
|
|
|
(setq new-timeline
|
|
|
(cl-remove-if (lambda (entry)
|
|
|
(<= (- (timeline-tools-entry-end-time entry)
|
|
|
(timeline-tools-entry-start-time entry))
|
|
|
threshold))
|
|
|
timeline))
|
|
|
|
|
|
;; reset start and end times
|
|
|
(setf (timeline-tools-entry-start-time (-first-item new-timeline)) start)
|
|
|
(setf (timeline-tools-entry-end-time (-last-item new-timeline)) end)
|
|
|
|
|
|
;; distribute gaps evenly among adjacent slots
|
|
|
(timeline-tools-fill-gaps new-timeline))))
|
|
|
|
|
|
(defun timeline-tools-fill-gaps (timeline)
|
|
|
"Fill gaps in TIMELINE evenly.
|
|
|
|
|
|
This is achieved by extending the start time and the end time of
|
|
|
the surrounding entries equally.
|
|
|
|
|
|
This function destructively modifies its first argument."
|
|
|
(cl-do
|
|
|
((sub-timeline timeline (cdr sub-timeline)))
|
|
|
((null (cdr sub-timeline)) timeline)
|
|
|
(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)))
|
|
|
(when (not (= end-1 start-2))
|
|
|
(let ((middle (/ (+ end-1 start-2) 2)))
|
|
|
(setf (timeline-tools-entry-end-time entry-1) middle)
|
|
|
(setf (timeline-tools-entry-start-time entry-2) middle))))))
|
|
|
|
|
|
(defun timeline-tools-transform-timeline (timeline)
|
|
|
"Return result of filtering TIMELINE.
|
|
|
Filtering is done by applying all functions from
|
|
|
`timeline-tools-filter-functions’, in order."
|
|
|
(-reduce-from (lambda (tl f)
|
|
|
(funcall f tl))
|
|
|
timeline
|
|
|
timeline-tools-filter-functions))
|
|
|
|
|
|
|
|
|
;; Interactive functions
|
|
|
|
|
|
;;;###autoload
|
|
|
(defun timeline-tools-format-timeline (tstart tend &optional files)
|
|
|
"Display timeline of tasks between TSTART and TEND from FILES.
|
|
|
|
|
|
When not given, FILES defaults to `org-agenda-files’ including
|
|
|
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’."
|
|
|
(interactive (list (org-read-date nil nil nil "Start time: ")
|
|
|
(org-read-date nil nil nil "End time: ")))
|
|
|
(let ((target-buffer (get-buffer-create " *Org Timeline*")))
|
|
|
(with-current-buffer target-buffer
|
|
|
(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-time-format timeline-tools-time-format)
|
|
|
(setq-local timeline-tools-headline-time-format timeline-tools-headline-time-format)
|
|
|
(timeline-tools-redraw-timeline 'force))
|
|
|
(pop-to-buffer target-buffer)
|
|
|
t))
|
|
|
|
|
|
;;;###autoload
|
|
|
(defun timeline-tools-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’.
|
|
|
When not given, FILES defaults to `org-agenda-files’ including
|
|
|
archives."
|
|
|
(interactive (list (org-read-date nil nil)))
|
|
|
(let ((timeline-tools-time-format "%H:%M")
|
|
|
(timeline-tools-headline-time-format "%Y-%m-%d"))
|
|
|
(timeline-tools-format-timeline (concat date " 00:00")
|
|
|
(org-read-date nil nil "++1d" nil
|
|
|
(org-time-string-to-time date))
|
|
|
files)))
|
|
|
|
|
|
(defun timeline-tools-redraw-timeline (&optional force)
|
|
|
"Redraw timeline of current buffer.
|
|
|
If `force' is non-nil, reparse the timeline using
|
|
|
`timeline-tools-timeline' within the time span given by the
|
|
|
current values of the relevant buffer local variables."
|
|
|
(interactive)
|
|
|
(if (not (eq major-mode 'timeline-tools-mode))
|
|
|
(user-error "Not in Timeline buffer")
|
|
|
(let ((timeline (timeline-tools-transform-timeline
|
|
|
(if force
|
|
|
(timeline-tools-timeline
|
|
|
timeline-tools--current-time-start
|
|
|
timeline-tools--current-time-end
|
|
|
timeline-tools--current-files)
|
|
|
(timeline-tools--get-timeline-from-buffer)))))
|
|
|
(erase-buffer)
|
|
|
(insert (format "* Timeline from [%s] to [%s]\n\n"
|
|
|
(format-time-string timeline-tools-headline-time-format
|
|
|
timeline-tools--current-time-start)
|
|
|
(format-time-string timeline-tools-headline-time-format
|
|
|
timeline-tools--current-time-end)))
|
|
|
(insert "|--|\n")
|
|
|
(insert "| Category | Start | End | Duration | Task |\n")
|
|
|
(let ((last-category nil)
|
|
|
(current-category nil))
|
|
|
(dolist (line timeline)
|
|
|
(setq current-category (funcall timeline-tools-category-function
|
|
|
line
|
|
|
timeline-tools--current-time-start
|
|
|
timeline-tools--current-time-end))
|
|
|
(when (not (equal last-category current-category))
|
|
|
(insert "|--|\n")
|
|
|
(setq last-category current-category))
|
|
|
(insert
|
|
|
(propertize (format "| %s | %s | %s | %s min | %s | \n"
|
|
|
current-category
|
|
|
(timeline-tools-format-entry-time line 'start)
|
|
|
(timeline-tools-format-entry-time line 'end)
|
|
|
(timeline-tools-entry-duration line)
|
|
|
(timeline-tools-entry-headline line))
|
|
|
'marker (timeline-tools-entry-marker line)
|
|
|
'entry line))))
|
|
|
(insert "|--|\n")
|
|
|
(org-table-align)
|
|
|
(goto-char (point-min))
|
|
|
(timeline-tools-next-line))))
|
|
|
|
|
|
(defun timeline-tools-next-line ()
|
|
|
"Move point to next line in timetable, if possible."
|
|
|
(interactive)
|
|
|
(unless (eq major-mode 'timeline-tools-mode)
|
|
|
(user-error "Not in Timeline buffer"))
|
|
|
(beginning-of-line)
|
|
|
(let ((point (point)))
|
|
|
(when (looking-at "^| ")
|
|
|
(forward-line))
|
|
|
(unless (re-search-forward "^| " nil 'no-error)
|
|
|
(goto-char point)
|
|
|
(user-error "No next line"))
|
|
|
(beginning-of-line)))
|
|
|
|
|
|
(defun timeline-tools-previous-line ()
|
|
|
"Move point to previous line in timetable, if possible."
|
|
|
(interactive)
|
|
|
(unless (eq major-mode 'timeline-tools-mode)
|
|
|
(user-error "Not in Timeline buffer"))
|
|
|
(beginning-of-line)
|
|
|
(let ((point (point)))
|
|
|
(unless (re-search-backward "^| " nil 'no-error)
|
|
|
(goto-char point)
|
|
|
(user-error "No previous line"))
|
|
|
(beginning-of-line)))
|
|
|
|
|
|
(defun timeline-tools--get-timeline-from-buffer ()
|
|
|
"Extract current timeline from buffer and return it.
|
|
|
This function expects the individual lines of a timeline to be
|
|
|
text properties under the keyword `entry' in the current buffer,
|
|
|
as it is done by `timeline-tools-redraw-timeline'."
|
|
|
(if (not (eq major-mode 'timeline-tools-mode))
|
|
|
(user-error "Not in Timeline buffer")
|
|
|
(let (timeline)
|
|
|
(save-mark-and-excursion
|
|
|
(goto-char (point-min))
|
|
|
(while (zerop (forward-line))
|
|
|
;; scan line for a text property named `entry'
|
|
|
(while (and (not (eolp))
|
|
|
(not (get-text-property (point) 'entry)))
|
|
|
(forward-char))
|
|
|
;; if not at the end, we have found something … add it
|
|
|
(unless (eolp)
|
|
|
(push (get-text-property (point) 'entry) timeline)))
|
|
|
(nreverse timeline)))))
|
|
|
|
|
|
(defun timeline-tools-reparse-timeline ()
|
|
|
"Parse timeline from files again and redraw 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)))
|
|
|
(timeline-tools-redraw-timeline 'force))
|
|
|
|
|
|
(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))
|
|
|
(timeline-tools-redraw-timeline 'force)))
|
|
|
|
|
|
(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))
|
|
|
(timeline-tools-redraw-timeline 'force)))
|
|
|
|
|
|
(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
|
|
|
(beginning-of-line)
|
|
|
(org-table-next-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)))
|
|
|
|
|
|
(defun timeline-tools-kill-line ()
|
|
|
"Delete line at point from the current timeline."
|
|
|
(interactive)
|
|
|
(unless (eq major-mode 'timeline-tools-mode)
|
|
|
(user-error "Not in Timeline buffer"))
|
|
|
(save-mark-and-excursion
|
|
|
;; get actual entry from headline of line
|
|
|
(beginning-of-line)
|
|
|
(unless (looking-at "^| ")
|
|
|
(user-error "Not in table"))
|
|
|
(org-table-next-field)
|
|
|
(let ((entry (get-text-property (point) 'entry)))
|
|
|
(unless entry
|
|
|
(user-error "Not on valid row in timeline"))
|
|
|
(kill-line)))
|
|
|
;; the call to `erase-buffer’ in `timeline-tools-redraw-timeline’ somehow
|
|
|
;; makes `save-mark-and-excursion’ meaningless; thus we save the number of the
|
|
|
;; current line by ourselves
|
|
|
(let ((linenum (line-number-at-pos (point))))
|
|
|
(timeline-tools-redraw-timeline)
|
|
|
(goto-char (point-min))
|
|
|
(forward-line (1- linenum))))
|
|
|
|
|
|
|
|
|
;;; Manipulating Clocklines
|
|
|
|
|
|
;; XXX: All this needs some autoloadable frontend
|
|
|
|
|
|
(defun timeline-tools-clockline-no-conflict (start end &rest buffers)
|
|
|
"Return clock line string from START to END.
|
|
|
|
|
|
START and END must be suitable arguments for `float-time’.
|
|
|
Update conflicting clock lines in BUFFERS before returning the
|
|
|
clock line."
|
|
|
(let ((new-start (float-time start))
|
|
|
(new-end (float-time end)))
|
|
|
(dolist (buffer buffers)
|
|
|
(with-current-buffer buffer
|
|
|
;; Make sure everything is visible, as otherwise editing may produce odd
|
|
|
;; results
|
|
|
(org-show-all)
|
|
|
|
|
|
(timeline-tools-map-clocklines
|
|
|
(lambda (timestamp-1 timestamp-2)
|
|
|
(let ((current-start (org-time-string-to-seconds timestamp-1))
|
|
|
(current-end (org-time-string-to-seconds 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)
|
|
|
(timeline-tools-insert-clockline current-start new-start)
|
|
|
(open-line 1)
|
|
|
(timeline-tools-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)
|
|
|
(timeline-tools-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)
|
|
|
(timeline-tools-insert-clockline current-start new-start)))))
|
|
|
|
|
|
;; Update current clock when on corresponding headline
|
|
|
#'(lambda ()
|
|
|
(when (and (eq (org-clocking-buffer) (current-buffer))
|
|
|
(eq (marker-position org-clock-hd-marker) (point)))
|
|
|
(let ((current-start (float-time org-clock-start-time))
|
|
|
(kill-whole-line nil) ; don’t delete newlines if not asked to
|
|
|
)
|
|
|
(when (< current-start new-end)
|
|
|
(save-mark-and-excursion
|
|
|
(org-clock-find-position t)
|
|
|
(beginning-of-line)
|
|
|
(kill-line)
|
|
|
(when (< current-start new-start)
|
|
|
;; Insert gap as separate clock line
|
|
|
(timeline-tools-insert-clockline current-start new-start)
|
|
|
(open-line 1))
|
|
|
(timeline-tools-insert-clockline new-end nil)
|
|
|
(setq org-clock-start-time (seconds-to-time new-end))))))))))
|
|
|
|
|
|
;; Return valid clockline
|
|
|
(with-temp-buffer
|
|
|
(timeline-tools-insert-clockline new-start new-end)
|
|
|
(buffer-string))))
|
|
|
|
|
|
(defun timeline-tools-add-clockline-to-marker
|
|
|
(target-marker start end &rest buffers)
|
|
|
"Add clock line from START to END to task under 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. BUFFERS must be a list of
|
|
|
buffers where to look for conflicting clock lines. Those
|
|
|
conflicting clock lines are updated accordingly. If BUFFERS is
|
|
|
not given, update clock lines in the buffer of TARGET-MARKER."
|
|
|
(when (not (markerp target-marker))
|
|
|
(user-error "Marker not valid"))
|
|
|
(let ((new-start (float-time start))
|
|
|
(new-end (float-time end))
|
|
|
(org-buffers (if buffers buffers (list (marker-buffer target-marker)))))
|
|
|
(let ((clock-line (apply #'timeline-tools-clockline-no-conflict
|
|
|
new-start new-end org-buffers)))
|
|
|
(org-with-point-at target-marker
|
|
|
(org-clock-find-position t)
|
|
|
;; if there is an unclosed clock line, add new clock line after it
|
|
|
(when (and (looking-at "^CLOCK:")
|
|
|
(not (looking-at ".* => ")))
|
|
|
(forward-line 1))
|
|
|
(open-line 1)
|
|
|
(insert clock-line)))))
|
|
|
|
|
|
;;;###autoload
|
|
|
(defun timeline-tools-clockline-no-org-agenda-conflicts ()
|
|
|
"Read clock line from user and return it.
|
|
|
|
|
|
Update all files in `org-agenda-files’ to update conflicting
|
|
|
clock lines, without restrictions. If `org-agenda-archive-mode’
|
|
|
is set, also include archive files."
|
|
|
(let* ((now (format-time-string "%H:%M"))
|
|
|
(start (org-read-date t nil nil "Started: " (current-time) now))
|
|
|
(end (org-read-date t nil nil "Ended: " (current-time) now)))
|
|
|
(apply #'timeline-tools-clockline-no-conflict
|
|
|
(org-time-string-to-seconds start)
|
|
|
(org-time-string-to-seconds end)
|
|
|
(mapcar #'find-file-noselect
|
|
|
(cl-remove-if-not #'file-exists-p
|
|
|
(org-agenda-files t 'ifmode))))))
|
|
|
|
|
|
(defun timeline-tools-copy-clocklines (source-id target-id)
|
|
|
"Copy clock lines from SOURCE-ID to TARGET-ID.
|
|
|
|
|
|
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."
|
|
|
(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 (timeline-tools-clocklines-of-task source-marker))
|
|
|
(timeline-tools-add-clockline-to-marker target-marker
|
|
|
(car clock-line) (cdr clock-line)))))
|
|
|
|
|
|
(defun timeline-tools-copy-inverted-clocklines (source-id target-id)
|
|
|
"Copy clock lines from SOURCE-ID to TARGET-ID.
|
|
|
|
|
|
Both SOURCE-ID and TARGET-ID must designate known `org-mode’
|
|
|
tasks by their ID. Considers all clock lines attached to
|
|
|
SOURCE-ID or to one of its subtree, and generates clock lines
|
|
|
starting at an end time of one clock line and ending at the start
|
|
|
time of the consecutive clock line. These inverted clock lines
|
|
|
are then copied to TARGET-ID and clock lines in the file of
|
|
|
TARGET-ID are adapted accordingly."
|
|
|
(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)
|
|
|
|
|
|
(let (inverted-timeline)
|
|
|
(dolist (clock-line (timeline-tools-clocklines-of-task source-marker))
|
|
|
(push (cdr clock-line) inverted-timeline)
|
|
|
(push (car clock-line) inverted-timeline))
|
|
|
|
|
|
(setq inverted-timeline (-partition 2 (cl-rest (reverse inverted-timeline))))
|
|
|
|
|
|
;; This is inefficient, but see comment in
|
|
|
;; `timeline-tools-copy-clocklines’ for rationale.
|
|
|
(dolist (clock-line inverted-timeline)
|
|
|
(timeline-tools-add-clockline-to-marker target-marker
|
|
|
(cadr clock-line) (car clock-line))))))
|
|
|
|
|
|
(provide 'timeline-tools)
|
|
|
;;; timeline-tools.el ends here
|