cp-daylog

This commit is contained in:
Kashish Sharma 2018-09-02 23:36:06 +05:30
parent f92b520396
commit 2a6def1605
1 changed files with 123 additions and 16 deletions

View File

@ -1,5 +1,41 @@
(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)
"Like `re-search-forward' but run `beginning-of-line'
afterwards. Return the value of `re-search-forward'."
@ -18,6 +54,7 @@ afterwards. Return the value of `re-search-forward'."
(setq stars (concat stars "\\*")))
(concat "^" stars " "))
cp/heading-rx))))
;; BUG - misbehaves if run with point at the end of a line
(defun cp/heading-level ()
(save-excursion
(if (cp/heading-p)
@ -25,6 +62,7 @@ afterwards. Return the value of `re-search-forward'."
"*"
(buffer-substring (point-at-bol)
(re-search-forward cp/heading-rx))))))
;; TODO - use format "%02d" instead
(defun cp/pad (int-str &optional spaces maxwidth)
(let* ((maxwidth (if maxwidth maxwidth 2))
(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)
"Like `org-forward-heading-same-level' but return nil if there
is no heading to go to, otherwise return line number of the new
position."
is no heading of the same level to go to, otherwise return line
number of the new position."
(if (cp/heading-p)
(let* ((point (point))
(target-level (cp/heading-level))
@ -77,6 +115,7 @@ position."
'(("playing" . "1")
("teaching" . "1t")
("piano" . "P")
("voice" . "V")
("improvisation" . "2")
("theory" . "3")
("composing" . "4")
@ -99,14 +138,13 @@ done."
(interactive)
(save-excursion
(catch 'invalid-activity
(if (or (progn (beginning-of-line)
(looking-at "^\\*\\* "))
;; ensure we're on a month
;; TODO - let user get a better error?
(if (or (cp/heading-p 2)
(outline-up-heading 1))
(let* ((act (if activity
activity
(read-from-minibuffer
"Activity: " nil nil nil
'cp/activity-history)))
(cp/read-activity)))
(point (point))
(end-of-month (progn
(forward-line)
@ -134,7 +172,7 @@ done."
" of "
(cp/pad (number-to-string month-days) t)
" days ("
;; percentage
;; percentage; add leading 0 if single digit
(if (string-match-p (rx (and bol any "."))
act-percent)
(concat "0" act-percent)
@ -157,21 +195,43 @@ done."
("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
;; BUG - does not work if you're on a date
(defun cp/activity-this-year-monthly ()
"Monthly review of an activity, for the period of the current
year."
(interactive)
(let ((activity (read-from-minibuffer
"Activity: " nil nil nil
'cp/activity-history)))
(if (or (cp/heading-p 1)
(outline-up-heading 1))
(progn
(save-excursion
(let ((activity ;; (read-from-minibuffer
;; "Activity: " nil nil nil
;; 'cp/activity-history)
(cp/read-activity)))
(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)
(goto-char (point-max)))
(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))
(princ
(concat
@ -185,6 +245,53 @@ year."
(cp/activity-this-month activity))
(princ "\n")
(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 ())
;; 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))