From 2a6def16053e84c7d374badd3003ced338c94cc1 Mon Sep 17 00:00:00 2001 From: Kashish Sharma Date: Sun, 2 Sep 2018 23:36:06 +0530 Subject: [PATCH] cp-daylog --- contrapunctus/cp-daylog.el | 139 ++++++++++++++++++++++++++++++++----- 1 file changed, 123 insertions(+), 16 deletions(-) diff --git a/contrapunctus/cp-daylog.el b/contrapunctus/cp-daylog.el index 6d55cff..5d55022 100644 --- a/contrapunctus/cp-daylog.el +++ b/contrapunctus/cp-daylog.el @@ -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))