cp-daylog
This commit is contained in:
parent
f92b520396
commit
2a6def1605
|
@ -1,5 +1,41 @@
|
||||||
(provide 'cp-daylog)
|
(provide 'cp-daylog)
|
||||||
|
|
||||||
|
;; TODO
|
||||||
|
;; 1. split each piece of information into different functions, to provide an extensible API
|
||||||
|
;; 2. interactive functions should be ones that "present" the information from those primitive functions
|
||||||
|
;; 3. see if you can build all this over M-x calendar
|
||||||
|
|
||||||
|
;; 1. current streak for $activity
|
||||||
|
;; 2. longest streak for $activity
|
||||||
|
;; 3. most productive day/week/month/year (i.e. day with most
|
||||||
|
;; activities done, or week/month/year with most such days)
|
||||||
|
;; 4. activity count this week (absolute or relative?)
|
||||||
|
;; 5. activity count this month
|
||||||
|
;; 6. activity count this year
|
||||||
|
;; 7. minimium possible and maximum possible
|
||||||
|
;; - e.g. if, in the first four days of a month (of 30) I've done
|
||||||
|
;; an activity on two days -
|
||||||
|
;; - my minimium possible is (/ 2 30.0) => 6.66%,
|
||||||
|
;; - and my maximum possible is (* (/ (+ (- 30 4)
|
||||||
|
;; 2)
|
||||||
|
;; 30.0)
|
||||||
|
;; 100)
|
||||||
|
;; => 93.33%
|
||||||
|
;; - ...could just subtract minimium possible from 100.00 ?
|
||||||
|
;; 8. Convert all regexps to rx macros
|
||||||
|
|
||||||
|
;; 2018-02-13T19:56:37+0530
|
||||||
|
(defun cp/read-activity ()
|
||||||
|
(interactive)
|
||||||
|
(completing-read "Activity: "
|
||||||
|
(-map 'car cp/activities)
|
||||||
|
nil
|
||||||
|
t
|
||||||
|
nil
|
||||||
|
'cp/activity-history
|
||||||
|
;; 2018-03-23T11:52:37+0530 - use last entered value as default
|
||||||
|
(car cp/activity-history)))
|
||||||
|
|
||||||
(defun cp/re-searchf-bol (regexp &optional bound noerror count)
|
(defun cp/re-searchf-bol (regexp &optional bound noerror count)
|
||||||
"Like `re-search-forward' but run `beginning-of-line'
|
"Like `re-search-forward' but run `beginning-of-line'
|
||||||
afterwards. Return the value of `re-search-forward'."
|
afterwards. Return the value of `re-search-forward'."
|
||||||
|
@ -18,6 +54,7 @@ afterwards. Return the value of `re-search-forward'."
|
||||||
(setq stars (concat stars "\\*")))
|
(setq stars (concat stars "\\*")))
|
||||||
(concat "^" stars " "))
|
(concat "^" stars " "))
|
||||||
cp/heading-rx))))
|
cp/heading-rx))))
|
||||||
|
;; BUG - misbehaves if run with point at the end of a line
|
||||||
(defun cp/heading-level ()
|
(defun cp/heading-level ()
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(if (cp/heading-p)
|
(if (cp/heading-p)
|
||||||
|
@ -25,6 +62,7 @@ afterwards. Return the value of `re-search-forward'."
|
||||||
"*"
|
"*"
|
||||||
(buffer-substring (point-at-bol)
|
(buffer-substring (point-at-bol)
|
||||||
(re-search-forward cp/heading-rx))))))
|
(re-search-forward cp/heading-rx))))))
|
||||||
|
;; TODO - use format "%02d" instead
|
||||||
(defun cp/pad (int-str &optional spaces maxwidth)
|
(defun cp/pad (int-str &optional spaces maxwidth)
|
||||||
(let* ((maxwidth (if maxwidth maxwidth 2))
|
(let* ((maxwidth (if maxwidth maxwidth 2))
|
||||||
(pad-char (if spaces " " "0"))
|
(pad-char (if spaces " " "0"))
|
||||||
|
@ -42,8 +80,8 @@ afterwards. Return the value of `re-search-forward'."
|
||||||
|
|
||||||
(defun cp/next-heading-same-level (&optional count)
|
(defun cp/next-heading-same-level (&optional count)
|
||||||
"Like `org-forward-heading-same-level' but return nil if there
|
"Like `org-forward-heading-same-level' but return nil if there
|
||||||
is no heading to go to, otherwise return line number of the new
|
is no heading of the same level to go to, otherwise return line
|
||||||
position."
|
number of the new position."
|
||||||
(if (cp/heading-p)
|
(if (cp/heading-p)
|
||||||
(let* ((point (point))
|
(let* ((point (point))
|
||||||
(target-level (cp/heading-level))
|
(target-level (cp/heading-level))
|
||||||
|
@ -77,6 +115,7 @@ position."
|
||||||
'(("playing" . "1")
|
'(("playing" . "1")
|
||||||
("teaching" . "1t")
|
("teaching" . "1t")
|
||||||
("piano" . "P")
|
("piano" . "P")
|
||||||
|
("voice" . "V")
|
||||||
("improvisation" . "2")
|
("improvisation" . "2")
|
||||||
("theory" . "3")
|
("theory" . "3")
|
||||||
("composing" . "4")
|
("composing" . "4")
|
||||||
|
@ -99,14 +138,13 @@ done."
|
||||||
(interactive)
|
(interactive)
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(catch 'invalid-activity
|
(catch 'invalid-activity
|
||||||
(if (or (progn (beginning-of-line)
|
;; ensure we're on a month
|
||||||
(looking-at "^\\*\\* "))
|
;; TODO - let user get a better error?
|
||||||
|
(if (or (cp/heading-p 2)
|
||||||
(outline-up-heading 1))
|
(outline-up-heading 1))
|
||||||
(let* ((act (if activity
|
(let* ((act (if activity
|
||||||
activity
|
activity
|
||||||
(read-from-minibuffer
|
(cp/read-activity)))
|
||||||
"Activity: " nil nil nil
|
|
||||||
'cp/activity-history)))
|
|
||||||
(point (point))
|
(point (point))
|
||||||
(end-of-month (progn
|
(end-of-month (progn
|
||||||
(forward-line)
|
(forward-line)
|
||||||
|
@ -134,7 +172,7 @@ done."
|
||||||
" of "
|
" of "
|
||||||
(cp/pad (number-to-string month-days) t)
|
(cp/pad (number-to-string month-days) t)
|
||||||
" days ("
|
" days ("
|
||||||
;; percentage
|
;; percentage; add leading 0 if single digit
|
||||||
(if (string-match-p (rx (and bol any "."))
|
(if (string-match-p (rx (and bol any "."))
|
||||||
act-percent)
|
act-percent)
|
||||||
(concat "0" act-percent)
|
(concat "0" act-percent)
|
||||||
|
@ -157,21 +195,43 @@ done."
|
||||||
("12" "December ")
|
("12" "December ")
|
||||||
(_ " ")))
|
(_ " ")))
|
||||||
|
|
||||||
|
(defun cp/ascend-to-heading (level)
|
||||||
|
"Ascend to heading LEVEL, where LEVEL is a positive integer."
|
||||||
|
(let ((point (point))
|
||||||
|
(current-level (progn (unless (cp/heading-p)
|
||||||
|
(outline-up-heading 0))
|
||||||
|
(cp/heading-level))))
|
||||||
|
(if (>= level current-level)
|
||||||
|
(progn
|
||||||
|
(goto-char point)
|
||||||
|
nil)
|
||||||
|
(progn
|
||||||
|
(while (not (equal level current-level))
|
||||||
|
;; outline-up-heading behaves oddly - we should need a 0 here, not 1
|
||||||
|
(outline-up-heading 1)
|
||||||
|
(setq current-level (cp/heading-level))))
|
||||||
|
t)))
|
||||||
|
|
||||||
;; TODO - add support for year range
|
;; TODO - add support for year range
|
||||||
|
;; BUG - does not work if you're on a date
|
||||||
(defun cp/activity-this-year-monthly ()
|
(defun cp/activity-this-year-monthly ()
|
||||||
"Monthly review of an activity, for the period of the current
|
"Monthly review of an activity, for the period of the current
|
||||||
year."
|
year."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((activity (read-from-minibuffer
|
(save-excursion
|
||||||
"Activity: " nil nil nil
|
(let ((activity ;; (read-from-minibuffer
|
||||||
'cp/activity-history)))
|
;; "Activity: " nil nil nil
|
||||||
(if (or (cp/heading-p 1)
|
;; 'cp/activity-history)
|
||||||
(outline-up-heading 1))
|
(cp/read-activity)))
|
||||||
(progn
|
(when (or (cp/heading-p 1)
|
||||||
|
(cp/ascend-to-heading 1))
|
||||||
|
(let ((year (save-excursion
|
||||||
|
(re-search-forward "[0-9]+$" (point-at-eol) t)
|
||||||
|
(match-string-no-properties 0))))
|
||||||
(or (cp/next-heading-same-level)
|
(or (cp/next-heading-same-level)
|
||||||
(goto-char (point-max)))
|
(goto-char (point-max)))
|
||||||
(re-search-backward "^\\*\\* ")
|
(re-search-backward "^\\*\\* ")
|
||||||
(with-output-to-temp-buffer (concat "*" activity "-this-year*")
|
(with-output-to-temp-buffer (concat "*" activity "-in-" year "*")
|
||||||
(while (not (cp/heading-p 1))
|
(while (not (cp/heading-p 1))
|
||||||
(princ
|
(princ
|
||||||
(concat
|
(concat
|
||||||
|
@ -185,6 +245,53 @@ year."
|
||||||
(cp/activity-this-month activity))
|
(cp/activity-this-month activity))
|
||||||
(princ "\n")
|
(princ "\n")
|
||||||
(or (cp/next-heading-same-level -1)
|
(or (cp/next-heading-same-level -1)
|
||||||
(outline-previous-heading))))))))
|
(outline-previous-heading)))))))))
|
||||||
|
|
||||||
|
(defun cp/activity-this-day? (activity-number)
|
||||||
|
"Was this activity done on the day at point?"
|
||||||
|
(save-excursion
|
||||||
|
(string-match-p
|
||||||
|
(concat "^\\*\\*\\* [0-9]\\{2\\} - .*?\\<"
|
||||||
|
activity-number
|
||||||
|
"[\\.-\\+]?\\>")
|
||||||
|
(buffer-substring-no-properties (point-at-bol)
|
||||||
|
(point-at-eol)))))
|
||||||
|
|
||||||
|
;; 2018-02-15T21:41:43+0530
|
||||||
|
;; Does it make sense to check for the 'current streak' if we haven't
|
||||||
|
;; done the activity today?
|
||||||
|
;; possible cases -
|
||||||
|
;; 1. The activity was done today
|
||||||
|
;; 2. The activity was not done today, and the user is going to
|
||||||
|
;; 3. The last day listed isn't _today_. The activity was not done
|
||||||
|
;; yesterday and the streak is 0.
|
||||||
|
;; Ah, screw it, going with "if it happened on the latest day it's a
|
||||||
|
;; streak, if it didn't, it's not."
|
||||||
|
(defun cp/current-streak (&optional activity)
|
||||||
|
"Return current streak for activity."
|
||||||
|
(interactive)
|
||||||
|
(let* ((act (if activity
|
||||||
|
activity
|
||||||
|
(cp/read-activity)))
|
||||||
|
(act-num (cp/act-name->number act))
|
||||||
|
(streak 0))
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (and
|
||||||
|
(re-search-forward "^\\*\\*\\* [0-9]\\{2\\} - ")
|
||||||
|
(cp/activity-this-day? act-num))
|
||||||
|
(setq streak (1+ streak))
|
||||||
|
(forward-line 1))
|
||||||
|
(princ streak))))
|
||||||
|
|
||||||
|
;; 2018-02-15T21:41:50+0530
|
||||||
|
;; TODO - cp/longest-streak-in-range
|
||||||
|
;; find streak for activity in time range
|
||||||
|
;; cp/current-streak can then seach in the time range "latest" to "beginning"
|
||||||
|
;; and one can search for the [longest] streak in whatever time range
|
||||||
|
|
||||||
(defun cp/most-productive-days-month ())
|
(defun cp/most-productive-days-month ())
|
||||||
|
|
||||||
|
;; 2018-06-26T10:35:47+0530
|
||||||
|
(with-eval-after-load 'org
|
||||||
|
(define-key org-mode-map (kbd "C-x C-a") 'cp/activity-this-year-monthly))
|
||||||
|
|
Loading…
Reference in New Issue