298 lines
11 KiB
EmacsLisp
298 lines
11 KiB
EmacsLisp
(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'."
|
|
(prog1 (re-search-forward regexp bound noerror count)
|
|
(beginning-of-line)))
|
|
|
|
(defun cp/negative-p (number) (< number 0))
|
|
(defun cp/positive-p (number) (>= number 0))
|
|
(defvar cp/heading-rx (rx-to-string '(and bol (1+ "*") " ")))
|
|
(defun cp/heading-p (&optional level)
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(looking-at-p (if level
|
|
(let ((stars ""))
|
|
(dotimes (i level stars)
|
|
(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)
|
|
(s-count-matches
|
|
"*"
|
|
(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"))
|
|
;; (test (princ (concat "diff - "
|
|
;; (number-to-string (- maxwidth (length int-str))))))
|
|
(diff (- maxwidth (length int-str)))
|
|
(final-pad))
|
|
(if (and (not (zerop diff))
|
|
(cp/positive-p diff))
|
|
(concat (dotimes (i diff final-pad)
|
|
(setq final-pad
|
|
(concat final-pad pad-char)))
|
|
int-str)
|
|
int-str)))
|
|
|
|
(defun cp/next-heading-same-level (&optional count)
|
|
"Like `org-forward-heading-same-level' but return nil if there
|
|
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))
|
|
(count (if (or (null count)
|
|
(zerop count))
|
|
1 count))
|
|
(negative-count (cp/negative-p count))
|
|
(result)
|
|
(last-target-level-headline (point)))
|
|
(while (or (not (zerop count))
|
|
(not result))
|
|
(if negative-count
|
|
(forward-line -1)
|
|
(forward-line 1))
|
|
(if (or (eobp) (cp/heading-p))
|
|
(cond
|
|
;; We've reached a higher-level heading or eob, stop
|
|
((or (eobp)
|
|
(< (cp/heading-level) target-level))
|
|
(setq result 1 count 0)
|
|
(goto-char last-target-level-headline))
|
|
;; We're at an equal-level heading
|
|
((= (cp/heading-level) target-level)
|
|
(setq result 0
|
|
count (if negative-count
|
|
(+ count 1) (- count 1))
|
|
last-target-level-headline (point))))))
|
|
(if (zerop result) (point) nil))))
|
|
|
|
(defvar cp/activities
|
|
'(("playing" . "1")
|
|
("teaching" . "1t")
|
|
("piano" . "P")
|
|
("voice" . "V")
|
|
("improvisation" . "2")
|
|
("theory" . "3")
|
|
("composing" . "4")
|
|
("listening" . "6")
|
|
("workout" . "7")
|
|
("programming" . "9")
|
|
("organizing" . "12")))
|
|
|
|
(defun cp/act-name->number (str)
|
|
(let ((result (assoc str cp/activities)))
|
|
(catch 'invalid-activity
|
|
(if result
|
|
(cdr result)
|
|
(throw 'invalid-activity
|
|
(princ (concat "Invalid activity \"" str "\"!")))))))
|
|
|
|
(defun cp/activity-this-month (&optional activity)
|
|
"For the month at point, count on how many days an activity was
|
|
done."
|
|
(interactive)
|
|
(save-excursion
|
|
(catch 'invalid-activity
|
|
;; 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
|
|
(cp/read-activity)))
|
|
(point (point))
|
|
(end-of-month (progn
|
|
(forward-line)
|
|
(or (cp/re-searchf-bol "^\\*\\* ")
|
|
(cp/re-searchf-bol "^\\* ")
|
|
(goto-char (point-max)))
|
|
(point)))
|
|
|
|
;; TODO - detect activities and corresponding numbers
|
|
;; automatically from legend. Offer menu to select.
|
|
(act-num (cp/act-name->number act))
|
|
(month-days (count-matches "^\\*\\*\\* "
|
|
point
|
|
end-of-month))
|
|
(act-count (->
|
|
(concat "^\\*\\*\\* [0-9]\\{2\\} - .*?\\<"
|
|
act-num "[\\.-\\+]?\\>")
|
|
(count-matches point end-of-month)))
|
|
(act-percent (->> (/ (float act-count)
|
|
(float month-days))
|
|
(* 100)
|
|
(format "%.2f"))))
|
|
(princ (concat
|
|
(cp/pad (number-to-string act-count) t)
|
|
" of "
|
|
(cp/pad (number-to-string month-days) t)
|
|
" days ("
|
|
;; percentage; add leading 0 if single digit
|
|
(if (string-match-p (rx (and bol any "."))
|
|
act-percent)
|
|
(concat "0" act-percent)
|
|
act-percent)
|
|
"%)")))))))
|
|
|
|
(defun cp/number->month-name (str)
|
|
(pcase str
|
|
("01" "January ")
|
|
("02" "February ")
|
|
("03" "March ")
|
|
("04" "April ")
|
|
("05" "May ")
|
|
("06" "June ")
|
|
("07" "July ")
|
|
("08" "August ")
|
|
("09" "September ")
|
|
("10" "October ")
|
|
("11" "November ")
|
|
("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)
|
|
(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 "-in-" year "*")
|
|
(while (not (cp/heading-p 1))
|
|
(princ
|
|
(concat
|
|
(cp/number->month-name
|
|
(buffer-substring (re-search-forward "^\\*\\* ")
|
|
(point-at-eol)))
|
|
;; " - "
|
|
" "))
|
|
(progn
|
|
(beginning-of-line)
|
|
(cp/activity-this-month activity))
|
|
(princ "\n")
|
|
(or (cp/next-heading-same-level -1)
|
|
(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))
|