forked from colonelpanic/dotfiles
[org-window-habit] Rearrange stuff and minor fixes
This commit is contained in:
parent
2612f57652
commit
8f95590d18
@ -9,47 +9,61 @@
|
|||||||
:group 'org-window-habit
|
:group 'org-window-habit
|
||||||
:type 'integer)
|
:type 'integer)
|
||||||
|
|
||||||
(defface org-window-habit-conformed-with-completion-face
|
(defcustom org-window-habit-following-days 7
|
||||||
'((((background light)) (:background "#40778f"))
|
"Number of days after today to appear in consistency graphs."
|
||||||
(((background dark)) (:background "#40778f")))
|
|
||||||
"Face for intervals for which the user was conforming only with their completion."
|
|
||||||
:group 'org-window-habit
|
:group 'org-window-habit
|
||||||
:group 'org-faces)
|
:type 'integer)
|
||||||
|
|
||||||
(defface org-window-habit-conforming-without-completion-face
|
(defvar org-window-habit-graph-assessment-fn
|
||||||
'((((background light)) (:background "#40578f"))
|
'org-window-habit-default-graph-assessment-fn)
|
||||||
(((background dark)) (:background "#40578f")))
|
|
||||||
"Face for intervals for which the user is conforming without any completions."
|
|
||||||
:group 'org-window-habit
|
|
||||||
:group 'org-faces)
|
|
||||||
|
|
||||||
(defface org-window-habit-conforming-with-completion-face
|
(define-minor-mode org-window-habit-mode
|
||||||
'((((background light)) (:background "#f5f946"))
|
"Minor mode that replaces the normal org-habit functionality."
|
||||||
(((background dark)) (:background "gold")))
|
:lighter nil
|
||||||
"Face for currently ongoing interval where user is conforming with completion."
|
:global t
|
||||||
:group 'org-window-habit
|
:group 'org-window-habit
|
||||||
:group 'org-faces)
|
:require 'org-window-habit)
|
||||||
|
|
||||||
(defface org-window-habit-okay-conforming-face
|
(defvar org-window-habit-conforming-color "#0000FF")
|
||||||
'((((background light)) (:background "#FF00FF"))
|
(defvar org-window-habit-not-conforming-color "#FF0000")
|
||||||
(((background dark)) (:background "#FF00FF")))
|
(defvar org-window-habit-required-completion-foreground-color "#000000")
|
||||||
"Face for interval in which the user is only okay conforming ."
|
(defvar org-window-habit-non-required-completion-foreground-color "#FFFFFF")
|
||||||
:group 'org-window-habit
|
(defvar org-window-habit-required-completion-today-foreground-color "#00FF00")
|
||||||
:group 'org-faces)
|
|
||||||
|
|
||||||
(defface org-window-habit-extreme-not-conforming-face
|
(defun org-window-habit-create-face (bg-color foreground-color)
|
||||||
'((((background light)) (:background "#fc9590"))
|
(let* ((bg-name (replace-regexp-in-string "#" "" bg-color))
|
||||||
(((background dark)) (:background "darkred")))
|
(fg-name (replace-regexp-in-string "#" "" foreground-color))
|
||||||
"Face for interval in which the user is not conforming by a large ."
|
(face-name (intern (format "org-window-habit-face-bg-%s-fg-%s" bg-name fg-name))))
|
||||||
:group 'org-window-habit
|
(if (facep face-name)
|
||||||
:group 'org-faces)
|
face-name
|
||||||
|
(progn
|
||||||
|
(make-face face-name)
|
||||||
|
(set-face-attribute face-name nil :background bg-color :foreground foreground-color)
|
||||||
|
face-name))))
|
||||||
|
|
||||||
(defface org-window-habit-not-conforming-face
|
(defcustom org-window-habit-completion-needed-today-glyph ?▂
|
||||||
'((((background light)) (:background "#f9372d"))
|
"Glyph character used to show days on which a completion is expected."
|
||||||
(((background dark)) (:background "firebrick")))
|
:group 'org-habit
|
||||||
"Face for interval in which the user is not conforming."
|
:version "24.1"
|
||||||
:group 'org-window-habit
|
:type 'character)
|
||||||
:group 'org-faces)
|
|
||||||
|
(defvar org-window-habit-non-conforming-scale .8)
|
||||||
|
|
||||||
|
(defun org-window-habit-rescale-assessment-value (value)
|
||||||
|
(if (>= value 1.0) value
|
||||||
|
(* org-window-habit-non-conforming-scale value)))
|
||||||
|
|
||||||
|
(defun org-window-habit-lerp-color (color1 color2 proportion)
|
||||||
|
(let ((r1 (string-to-number (substring color1 1 3) 16))
|
||||||
|
(g1 (string-to-number (substring color1 3 5) 16))
|
||||||
|
(b1 (string-to-number (substring color1 5 7) 16))
|
||||||
|
(r2 (string-to-number (substring color2 1 3) 16))
|
||||||
|
(g2 (string-to-number (substring color2 3 5) 16))
|
||||||
|
(b2 (string-to-number (substring color2 5 7) 16)))
|
||||||
|
(format "#%02x%02x%02x"
|
||||||
|
(round (+ (* (- r2 r1) proportion) r1))
|
||||||
|
(round (+ (* (- g2 g1) proportion) g1))
|
||||||
|
(round (+ (* (- b2 b1) proportion) b1)))))
|
||||||
|
|
||||||
(defun org-window-habit-time-max (&rest args)
|
(defun org-window-habit-time-max (&rest args)
|
||||||
"Return the maximum time value from ARGS."
|
"Return the maximum time value from ARGS."
|
||||||
@ -216,6 +230,16 @@
|
|||||||
(* space)
|
(* space)
|
||||||
(regexp org-ts-regexp-inactive)))
|
(regexp org-ts-regexp-inactive)))
|
||||||
|
|
||||||
|
(defun time-less-or-equal-p (time1 time2)
|
||||||
|
(or (time-less-p time1 time2)
|
||||||
|
(time-equal-p time1 time2)))
|
||||||
|
|
||||||
|
(defun time-greater-p (time1 time2)
|
||||||
|
(time-less-p time2 time1))
|
||||||
|
|
||||||
|
(defun time-greater-or-equal-p (time1 time2)
|
||||||
|
(time-less-or-equal-p time2 time1))
|
||||||
|
|
||||||
(defun org-window-habit-default-aggregation-fn (collection)
|
(defun org-window-habit-default-aggregation-fn (collection)
|
||||||
(cl-loop for el in collection minimize (car el)))
|
(cl-loop for el in collection minimize (car el)))
|
||||||
|
|
||||||
@ -228,6 +252,7 @@
|
|||||||
(assessment-decrement-plist :initarg :assessment-decrement-plist :initform nil)
|
(assessment-decrement-plist :initarg :assessment-decrement-plist :initform nil)
|
||||||
(max-repetitions-per-interval :initarg :max-repetitions-per-interval :initform 1)
|
(max-repetitions-per-interval :initarg :max-repetitions-per-interval :initform 1)
|
||||||
(aggregation-fn :initarg :aggregation-fn :initform 'org-window-habit-default-aggregation-fn)
|
(aggregation-fn :initarg :aggregation-fn :initform 'org-window-habit-default-aggregation-fn)
|
||||||
|
(graph-assessment-fn :initarg :graph-assessment-fn :initform nil)
|
||||||
(start-time :initarg :start-time)))
|
(start-time :initarg :start-time)))
|
||||||
|
|
||||||
(defclass org-window-habit-iterator ()
|
(defclass org-window-habit-iterator ()
|
||||||
@ -382,21 +407,6 @@
|
|||||||
while (funcall comparison time testing-value)
|
while (funcall comparison time testing-value)
|
||||||
finally return index))
|
finally return index))
|
||||||
|
|
||||||
(defun time-less-or-equal-p (time1 time2)
|
|
||||||
(or (time-less-p time1 time2)
|
|
||||||
(time-equal-p time1 time2)))
|
|
||||||
|
|
||||||
(defun time-greater-p (time1 time2)
|
|
||||||
(time-less-p time2 time1))
|
|
||||||
|
|
||||||
(defun time-greater-or-equal-p (time1 time2)
|
|
||||||
(time-less-or-equal-p time2 time1))
|
|
||||||
|
|
||||||
(defun test-org-window-habit-get-completion-window-indices (start-time end-time)
|
|
||||||
(interactive)
|
|
||||||
(org-window-habit-get-completion-window-indices
|
|
||||||
(org-window-habit-create-instance-from-heading-at-point) start-time end-time))
|
|
||||||
|
|
||||||
(cl-defmethod org-window-habit-get-completion-window-indices
|
(cl-defmethod org-window-habit-get-completion-window-indices
|
||||||
((habit org-window-habit) start-time end-time
|
((habit org-window-habit) start-time end-time
|
||||||
&key (start-index nil) (end-index nil) (reverse nil))
|
&key (start-index nil) (end-index nil) (reverse nil))
|
||||||
@ -429,20 +439,6 @@
|
|||||||
:comparison 'time-greater-or-equal-p
|
:comparison 'time-greater-or-equal-p
|
||||||
:start-index end-index)))))
|
:start-index end-index)))))
|
||||||
|
|
||||||
(cl-defmethod org-window-habit-advance-window
|
|
||||||
((window-habit org-window-habit) start-time end-time &key (direction 1))
|
|
||||||
(with-slots (assessment-interval) window-habit
|
|
||||||
(let ((interval-movement-plist (org-window-habit-multiply-plist
|
|
||||||
assessment-interval direction)))
|
|
||||||
(list
|
|
||||||
(org-window-habit-keyed-duration-add-plist start-time interval-movement-plist)
|
|
||||||
(org-window-habit-keyed-duration-add-plist end-time interval-movement-plist)))))
|
|
||||||
|
|
||||||
(defcustom org-window-habit-following-days 7
|
|
||||||
"Number of days after today to appear in consistency graphs."
|
|
||||||
:group 'org-window-habit
|
|
||||||
:type 'integer)
|
|
||||||
|
|
||||||
(cl-defmethod org-window-habit-advance
|
(cl-defmethod org-window-habit-advance
|
||||||
((iterator org-window-habit-iterator) &key (amount nil))
|
((iterator org-window-habit-iterator) &key (amount nil))
|
||||||
(with-slots (window window-spec) iterator
|
(with-slots (window window-spec) iterator
|
||||||
@ -510,8 +506,11 @@
|
|||||||
(with-slots
|
(with-slots
|
||||||
(assessment-decrement-plist window-specs reschedule-interval
|
(assessment-decrement-plist window-specs reschedule-interval
|
||||||
max-repetitions-per-interval start-time aggregation-fn
|
max-repetitions-per-interval start-time aggregation-fn
|
||||||
assessment-interval)
|
assessment-interval graph-assessment-fn)
|
||||||
habit
|
habit
|
||||||
|
(unless graph-assessment-fn
|
||||||
|
(setq graph-assessment-fn
|
||||||
|
org-window-habit-graph-assessment-fn))
|
||||||
(cl-destructuring-bind (actual-intervals actual-start-time)
|
(cl-destructuring-bind (actual-intervals actual-start-time)
|
||||||
(cl-loop
|
(cl-loop
|
||||||
with target-start-time = (org-window-habit-normalize-time-to-duration
|
with target-start-time = (org-window-habit-normalize-time-to-duration
|
||||||
@ -533,8 +532,10 @@
|
|||||||
collect
|
collect
|
||||||
(org-window-habit-iterator-from-time
|
(org-window-habit-iterator-from-time
|
||||||
window-spec actual-start-time))
|
window-spec actual-start-time))
|
||||||
for current-assessment-start = (oref (oref (car iterators) window) assessment-start-time)
|
for current-assessment-start =
|
||||||
for current-assessment-end = (oref (oref (car iterators) window) assessment-end-time)
|
(oref (oref (car iterators) window) assessment-start-time)
|
||||||
|
for current-assessment-end =
|
||||||
|
(oref (oref (car iterators) window) assessment-end-time)
|
||||||
while (time-less-p current-assessment-end now)
|
while (time-less-p current-assessment-end now)
|
||||||
for conforming-values-no-comp =
|
for conforming-values-no-comp =
|
||||||
(cl-loop for iterator in iterators
|
(cl-loop for iterator in iterators
|
||||||
@ -550,15 +551,9 @@
|
|||||||
(cl-loop for iterator in iterators
|
(cl-loop for iterator in iterators
|
||||||
collect (org-window-habit-get-conforming-value iterator))
|
collect (org-window-habit-get-conforming-value iterator))
|
||||||
for assessment-value = (funcall aggregation-fn conforming-values)
|
for assessment-value = (funcall aggregation-fn conforming-values)
|
||||||
do
|
|
||||||
(message "%s %s %s"
|
|
||||||
(org-window-habit-time-to-string current-assessment-start)
|
|
||||||
(org-window-habit-time-to-string current-assessment-end)
|
|
||||||
(org-window-habit-get-completion-count
|
|
||||||
habit current-assessment-start current-assessment-end))
|
|
||||||
collect
|
collect
|
||||||
(funcall
|
(funcall
|
||||||
org-window-habit-graph-assessment-fn
|
graph-assessment-fn
|
||||||
assessment-value-no-comp
|
assessment-value-no-comp
|
||||||
assessment-value
|
assessment-value
|
||||||
(org-window-habit-get-completion-count
|
(org-window-habit-get-completion-count
|
||||||
@ -591,7 +586,7 @@
|
|||||||
(funcall aggregation-fn with-completion-conforming-values))
|
(funcall aggregation-fn with-completion-conforming-values))
|
||||||
(current-assessment
|
(current-assessment
|
||||||
(funcall
|
(funcall
|
||||||
org-window-habit-graph-assessment-fn
|
graph-assessment-fn
|
||||||
assessment-value
|
assessment-value
|
||||||
with-completion-assessment-value
|
with-completion-assessment-value
|
||||||
(org-window-habit-get-completion-count
|
(org-window-habit-get-completion-count
|
||||||
@ -611,16 +606,9 @@
|
|||||||
(put-text-property index (1+ index) 'face face graph)))
|
(put-text-property index (1+ index) 'face face graph)))
|
||||||
graph))
|
graph))
|
||||||
|
|
||||||
(define-minor-mode org-window-habit-mode
|
|
||||||
"Minor mode that replaces the normal org-habit functionality."
|
|
||||||
:lighter nil
|
|
||||||
:global t
|
|
||||||
:group 'org-window-habit
|
|
||||||
:require 'org-window-habit)
|
|
||||||
|
|
||||||
(defun org-window-habit-parse-todo-advice (orig &rest args)
|
(defun org-window-habit-parse-todo-advice (orig &rest args)
|
||||||
(if org-window-habit-mode
|
(if org-window-habit-mode
|
||||||
(org-window-habit-parse-todo)
|
(org-window-habit-create-instance-from-heading-at-point)
|
||||||
(apply orig args)))
|
(apply orig args)))
|
||||||
|
|
||||||
(advice-add 'org-habit-parse-todo
|
(advice-add 'org-habit-parse-todo
|
||||||
@ -671,12 +659,6 @@
|
|||||||
fill-completions-fn
|
fill-completions-fn
|
||||||
interval-start-time
|
interval-start-time
|
||||||
(- end-index start-index)))
|
(- end-index start-index)))
|
||||||
do
|
|
||||||
(message "%s %s %s %s"
|
|
||||||
(org-window-habit-time-to-string interval-start-time)
|
|
||||||
(org-window-habit-time-to-string interval-end-time)
|
|
||||||
start-index
|
|
||||||
end-index)
|
|
||||||
sum completions-within-interval
|
sum completions-within-interval
|
||||||
do (setq next-start-index end-index
|
do (setq next-start-index end-index
|
||||||
interval-end-time interval-start-time)
|
interval-end-time interval-start-time)
|
||||||
@ -712,49 +694,6 @@
|
|||||||
do (org-window-habit-advance iterator))
|
do (org-window-habit-advance iterator))
|
||||||
finally return current-assessment-start)))
|
finally return current-assessment-start)))
|
||||||
|
|
||||||
(defvar org-window-habit-face-fn 'org-window-habit-default-face-fn)
|
|
||||||
|
|
||||||
(defun org-window-habit-lerp-color (color1 color2 proportion)
|
|
||||||
(let ((r1 (string-to-number (substring color1 1 3) 16))
|
|
||||||
(g1 (string-to-number (substring color1 3 5) 16))
|
|
||||||
(b1 (string-to-number (substring color1 5 7) 16))
|
|
||||||
(r2 (string-to-number (substring color2 1 3) 16))
|
|
||||||
(g2 (string-to-number (substring color2 3 5) 16))
|
|
||||||
(b2 (string-to-number (substring color2 5 7) 16)))
|
|
||||||
(format "#%02x%02x%02x"
|
|
||||||
(round (+ (* (- r2 r1) proportion) r1))
|
|
||||||
(round (+ (* (- g2 g1) proportion) g1))
|
|
||||||
(round (+ (* (- b2 b1) proportion) b1)))))
|
|
||||||
|
|
||||||
(defvar org-window-habit-conforming-color "#0000FF")
|
|
||||||
(defvar org-window-habit-not-conforming-color "#FF0000")
|
|
||||||
(defvar org-window-habit-required-completion-foreground-color "#000000")
|
|
||||||
(defvar org-window-habit-non-required-completion-foreground-color "#FFFFFF")
|
|
||||||
(defvar org-window-habit-required-completion-today-foreground-color "#00FF00")
|
|
||||||
|
|
||||||
(defun org-window-habit-create-face (bg-color foreground-color)
|
|
||||||
(let* ((bg-name (replace-regexp-in-string "#" "" bg-color))
|
|
||||||
(fg-name (replace-regexp-in-string "#" "" foreground-color))
|
|
||||||
(face-name (intern (format "org-window-habit-face-bg-%s-fg-%s" bg-name fg-name))))
|
|
||||||
(if (facep face-name)
|
|
||||||
face-name
|
|
||||||
(progn
|
|
||||||
(make-face face-name)
|
|
||||||
(set-face-attribute face-name nil :background bg-color :foreground foreground-color)
|
|
||||||
face-name))))
|
|
||||||
|
|
||||||
(defcustom org-window-habit-completion-needed-today-glyph ?▂
|
|
||||||
"Glyph character used to show days on which a completion is expected."
|
|
||||||
:group 'org-habit
|
|
||||||
:version "24.1"
|
|
||||||
:type 'character)
|
|
||||||
|
|
||||||
(defvar org-window-habit-non-conforming-scale .8)
|
|
||||||
|
|
||||||
(defun org-window-habit-rescale-assessment-value (value)
|
|
||||||
(if (>= value 1.0) value
|
|
||||||
(* org-window-habit-non-conforming-scale value)))
|
|
||||||
|
|
||||||
(cl-defun org-window-habit-default-graph-assessment-fn
|
(cl-defun org-window-habit-default-graph-assessment-fn
|
||||||
(without-completion-assessment-value
|
(without-completion-assessment-value
|
||||||
with-completion-assessment-value
|
with-completion-assessment-value
|
||||||
@ -802,9 +741,6 @@
|
|||||||
(t ?\s))))
|
(t ?\s))))
|
||||||
(list character face)))
|
(list character face)))
|
||||||
|
|
||||||
(defvar org-window-habit-graph-assessment-fn
|
|
||||||
'org-window-habit-default-graph-assessment-fn)
|
|
||||||
|
|
||||||
(defun org-window-habit-auto-repeat (&rest args)
|
(defun org-window-habit-auto-repeat (&rest args)
|
||||||
(interactive)
|
(interactive)
|
||||||
(let* ((required-interval-start
|
(let* ((required-interval-start
|
||||||
|
Loading…
Reference in New Issue
Block a user