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

[Timeline] Remove code for clustered entries 

Now all entries have exactly one marker.
This commit is contained in:
Daniel - 2018-11-28 15:44:48 +01:00
parent 6ad90e02b9
commit 57a8f25ea0
Signed by: dbo
GPG Key ID: 4F63DB96D45AA9C6
1 changed files with 28 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,7 +22,8 @@
:group 'applications) :group 'applications)
(defcustom timeline-tools-filter-functions (defcustom timeline-tools-filter-functions
(list #'timeline-tools-remove-short-entries #'timeline-tools-cluster-same-entry) (list #'timeline-tools-remove-short-entries
#'timeline-tools-cluster-same-entries)
"List of functions to apply when formatting timelines. "List of functions to apply when formatting timelines.
Filter are applied in the order they are given in this list." Filter are applied in the order they are given in this list."
:group 'timeline-tools :group 'timeline-tools
@ -79,14 +80,15 @@ Filter are applied in the order they are given in this list."
(defalias 'timeline-tools-entry-end-time 'cadr (defalias 'timeline-tools-entry-end-time 'cadr
"End time of ENTRY.") "End time of ENTRY.")
(defalias 'timeline-tools-entry-markers 'caddr (defalias 'timeline-tools-entry-marker 'caddr
"Marker to org task of ENTRY.") "Marker to org task of ENTRY.")
(defun timeline-tools-make-entry (start-time end-time markers) (defun timeline-tools-make-entry (start-time end-time marker)
"Return a timeline entry made up of START-TIME, END-TIME, and MARKERS. "Return a timeline entry made up of START-TIME, END-TIME, and MARKER.
MARKER may be a list of markers, or a single marker. Duplicate MARKER must be a single marker."
markers will only be kept once." (unless (markerp marker)
(list start-time end-time (if (listp markers) (-uniq markers) (list markers)))) (user-error "No marker given."))
(list start-time end-time marker))
(defun timeline-tools-entry-duration (entry) (defun timeline-tools-entry-duration (entry)
"Returns the duration of ENTRY, in minutes." "Returns the duration of ENTRY, in minutes."
@ -97,20 +99,19 @@ markers will only be kept once."
(defun timeline-tools-entry-category (entry) (defun timeline-tools-entry-category (entry)
"Return ARCHIVE_CATEGORY or CATEGORY at position given by MARKER. "Return ARCHIVE_CATEGORY or CATEGORY at position given by MARKER.
Return whatever is found first." Return whatever is found first."
(let ((marker (car (timeline-tools-entry-markers entry)))) (let ((marker (timeline-tools-entry-marker entry)))
(or (org-entry-get marker "ARCHIVE_CATEGORY") (or (org-entry-get marker "ARCHIVE_CATEGORY")
(org-entry-get marker "CATEGORY")))) (org-entry-get marker "CATEGORY"))))
(defun timeline-tools-entry-headlines (entry) (defun timeline-tools-entry-headline (entry)
"Return list of all headlines associated with ENTRY. "Return the headline associated with ENTRY.
The headline will be a string, propertized with a property called The headline will be a string, propertized with a property called
`marker’ and a corresponding marker pointing to the headline." `marker’ and a corresponding marker pointing to the headline."
(mapcar (lambda (marker) (let* ((marker (timeline-tools-entry-marker entry))
(let ((heading (org-with-point-at marker (heading (org-with-point-at marker
(org-element-headline-parser (point-max))))) (org-element-headline-parser (point-max)))))
(propertize (plist-get (cadr heading) :raw-value) (propertize (plist-get (cadr heading) :raw-value)
'marker marker))) 'marker marker)))
(timeline-tools-entry-markers entry)))
;; Utilities ;; Utilities
@ -301,18 +302,14 @@ Markers to org mode tasks are combined into a list."
This only works if every entry in timeline consists of a This only works if every entry in timeline consists of a
singleton marker only. In case this is not satisfied, this singleton marker only. In case this is not satisfied, this
function will throw an error." 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) (let ((new-timeline (-partition-by #'(lambda (entry)
(-first-item (timeline-tools-entry-markers entry))) (timeline-tools-entry-marker entry))
timeline))) timeline)))
(mapcar (lambda (cluster) (mapcar (lambda (cluster)
(timeline-tools-make-entry (timeline-tools-make-entry
(timeline-tools-entry-start-time (-first-item cluster)) (timeline-tools-entry-start-time (-first-item cluster))
(timeline-tools-entry-end-time (-last-item cluster)) (timeline-tools-entry-end-time (-last-item cluster))
(-mapcat #'timeline-tools-entry-markers cluster))) (timeline-tools-entry-markers (-first-item cluster))))
new-timeline))) new-timeline)))
(defun timeline-tools-remove-short-entries (timeline &optional threshold) (defun timeline-tools-remove-short-entries (timeline &optional threshold)
@ -423,20 +420,16 @@ archives."
(insert "|--|\n") (insert "|--|\n")
(insert "| Category | Start | End | Duration | Task |\n") (insert "| Category | Start | End | Duration | Task |\n")
(let ((last-category nil)) (let ((last-category nil))
(dolist (cluster timeline) (dolist (line timeline)
(when (not (equal last-category (timeline-tools-entry-category cluster))) (when (not (equal last-category (timeline-tools-entry-category line)))
(insert "|--|\n") (insert "|--|\n")
(setq last-category (timeline-tools-entry-category cluster))) (setq last-category (timeline-tools-entry-category line)))
(insert (format "| %s | %s | %s | %s min | " (insert (format "| %s | %s | %s | %s min | %s | \n"
(timeline-tools-entry-category cluster) (timeline-tools-entry-category line)
(timeline-tools-format-entry-time cluster 'start) (timeline-tools-format-entry-time line 'start)
(timeline-tools-format-entry-time cluster 'end) (timeline-tools-format-entry-time line 'end)
(timeline-tools-entry-duration cluster))) (timeline-tools-entry-duration line)
;; insert headline line by line (timeline-tools-entry-headline line)))))
(dolist (headline (-interpose "|\n |||||"
(timeline-tools-entry-headlines cluster)))
(insert headline))
(insert "\n")))
(insert "|--|\n") (insert "|--|\n")
(org-table-align) (org-table-align)
(goto-char (point-min))))) (goto-char (point-min)))))