dbo/.emacs.d
dbo
/
.emacs.d
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

[Timeline] Extract gap-filling into separate function

This commit is contained in:
Daniel - 2018-11-28 16:50:18 +01:00
parent f2db1f5b5e
commit 62ac9a887b
Signed by: dbo
GPG Key ID: 4F63DB96D45AA9C6
1 changed files with 38 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
site-lisp/timeline-tools.el
View File

@ -44,7 +44,7 @@
:group 'applications)
(defcustom timeline-tools-filter-functions
(list #'timeline-tools-remove-short-entries
(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."
@ -332,39 +332,48 @@ function will throw an error."
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."
`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)
(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))
;; 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)
;; 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
(cl-do
((sub-timeline new-timeline (cdr sub-timeline)))
((null (cdr sub-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)))))
;; distribute gaps evenly among adjacent slots
(timeline-tools-fill-gaps new-timeline))))
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 timeline from files, after application of