cp-daylog
This commit is contained in:
parent
f92b520396
commit
2a6def1605
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue