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

[Timeline] Don’t use ‘cl’ 

Lot’s of ‘car’s and ‘cdr’s now!
This commit is contained in:
Daniel - 2018-01-24 20:50:04 +01:00
parent 0a5dc32b98
commit fe1a509acf
Signed by: dbo
GPG Key ID: 4F63DB96D45AA9C6
1 changed files with 16 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,8 +8,6 @@
;;; Code: ;;; Code:
(eval-when-compile
(require 'cl))
(require 'dash) (require 'dash)
(require 'org) (require 'org)
(require 'org-clock) (require 'org-clock)
@ -214,8 +212,8 @@ Markers to org mode tasks are combined into a list."
(org-entry-get marker "CATEGORY"))) (org-entry-get marker "CATEGORY")))
timeline))) timeline)))
(mapcar (lambda (cluster) (mapcar (lambda (cluster)
(list (first (first cluster)) ; start of first entry (list (caar cluster) ; start of first entry
(second (car (last cluster))) ; end of last entry (cadar (last cluster)) ; end of last entry
(mapcar #'third cluster))) (mapcar #'third cluster)))
new-timeline))) new-timeline)))
@ -224,31 +222,32 @@ Markers to org mode tasks are combined into a list."
A slot is short if it is not longer than THRESHOLD seconds. A slot is short if it is not longer than THRESHOLD seconds.
Resulting gaps are distributed evenly among adjacent slots." Resulting gaps are distributed evenly among adjacent slots."
(let ((start (first (first timeline))) (let ((start (caar timeline))
(end (second (car (last timeline)))) (end (cadar (last timeline)))
new-timeline) new-timeline)
;; remove all slots that are too short ;; remove all slots that are too short
(setq new-timeline (setq new-timeline
(cl-remove-if (lambda (entry) (cl-remove-if (lambda (entry)
(<= (- (second entry) (first entry)) (<= (- (cadr entry) (car entry))
timeline-tools-short-task-threshold)) timeline-tools-short-task-threshold))
timeline)) timeline))
;; reset start and end times ;; reset start and end times
(setf (first (first new-timeline)) start) (setf (caar new-timeline) start)
(setf (second (car (last new-timeline))) end) (setf (cadar (last new-timeline)) end)
;; distribute gaps evenly among adjacent slots ;; distribute gaps evenly among adjacent slots
(do ((sub-timeline new-timeline (cdr sub-timeline))) (cl-do
((sub-timeline new-timeline (cdr sub-timeline)))
((null (cdr sub-timeline))) ((null (cdr sub-timeline)))
(let* ((entry-1 (first sub-timeline)) (let* ((entry-1 (car sub-timeline))
(entry-2 (second sub-timeline)) (entry-2 (cadr sub-timeline))
(end-1 (second entry-1)) (end-1 (cadr entry-1))
(start-2 (first entry-2))) (start-2 (car entry-2)))
(when (not (= end-1 start-2)) (when (not (= end-1 start-2))
(let ((middle (/ (+ end-1 start-2) 2))) (let ((middle (/ (+ end-1 start-2) 2)))
(setf (second entry-1) middle) (setf (cadr entry-1) middle)
(setf (first entry-2) middle))))) (setf (car entry-2) middle)))))
new-timeline)) new-timeline))
;;;###autoload ;;;###autoload
@ -275,7 +274,7 @@ When called interactively, START and END are queried with
(dolist (cluster timeline) (dolist (cluster timeline)
(cl-destructuring-bind (start end markers) cluster (cl-destructuring-bind (start end markers) cluster
(insert (format "| %s | %s | %s | %s min | " (insert (format "| %s | %s | %s | %s min | "
(org-entry-get (first markers) "CATEGORY") (org-entry-get (car markers) "CATEGORY")
(format-time-string "%Y-%m-%d %H:%M" start) (format-time-string "%Y-%m-%d %H:%M" start)
(format-time-string "%Y-%m-%d %H:%M" end) (format-time-string "%Y-%m-%d %H:%M" end)
(floor (/ (- end start) 60)))) (floor (/ (- end start) 60))))