diff options
| -rw-r--r-- | Changelog.org | 7 | ||||
| -rw-r--r-- | org-fc-dashboard.el | 278 | ||||
| -rw-r--r-- | org-fc.el | 236 |
3 files changed, 286 insertions, 235 deletions
diff --git a/Changelog.org b/Changelog.org index ce00d03..d27ebf5 100644 --- a/Changelog.org +++ b/Changelog.org @@ -6,8 +6,15 @@ In case a update to the org sources is needed, I'll add a changelog entry with updating instructions. ** [2020-11-11 Wed] +*** Added The dashboard now includes a forecast of how many cards will be due during the next day, week (+7 days) or month (+30 days). +*** Changed +- All dashboard functions were extracted to a separate file +- ~org-fc-stats~ was renamed to ~org-fc-dashboard-stats~ +- ~org-fc--hashtable-to-alist~ was renamed to ~org-fc-dashboard--hashtable-to-alist~ +- ~org-fc-context-dashboard~ was renamed to ~org-fc-dashboard-context~ +- ~org-fc-review-dashboard-context~ was renamed to ~org-fc-dashboard-review~ ** [2020-09-09 Wed] Org-fc now supports nested flashcards. diff --git a/org-fc-dashboard.el b/org-fc-dashboard.el new file mode 100644 index 0000000..e9d593c --- /dev/null +++ b/org-fc-dashboard.el @@ -0,0 +1,278 @@ +;;; org-fc-dashboard.el --- Dashboard buffer for org-fc -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Leon Rische + +;; Author: Leon Rische <emacs@leonrische.me> +;; Url: https://www.leonrische.me/pages/org_flashcards.html +;; Package-requires: ((emacs "26.3") (org "9.3")) +;; Version: 0.0.1 + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; The dashboard shows an overview over all cards in the system (or in +;; the current context. +;; +;;; Code: +;;; Customization + +(defcustom org-fc-dashboard-bar-chart-width 400 + "Width of the svg generated to display review statistics." + :type 'integer + :group 'org-fc) + +(defcustom org-fc-dashboard-bar-chart-height 20 + "Height of the svg generated to display review statistics." + :type 'integer + :group 'org-fc) + +(defcustom org-fc-dashboard-text-bar-chart-width 40 + "Width of the text-bar chart used to display review statistics. +This is only used org-fc is run in a non-graphic display +environment without svg support." + :type 'integer + :group 'org-fc) + +(defcustom org-fc-dashboard-buffer-name "*org-fc Dashboard*" + "Name of the buffer to use for displaying the dashboard view." + :type 'string + :group 'org-fc) + +;;; Variables + +(defvar org-fc-dashboard-context org-fc-context-all + "Context of the current dashboard view.") + +;;; Helper Functions + +(defun org-fc-dashboard--hashtable-to-alist (ht) + "Convert a hash-table HT to an alist." + (let (res) + (dolist (key (hash-table-keys ht)) + (push (cons key (gethash key ht)) res)) + res)) + +;;; Stats + +(defun org-fc-dashboard-stats (index) + "Compute statistics for an INDEX of cards and positions." + (let* ((total 0) (suspended 0) + (by-type (make-hash-table)) + (avg-ease 0.0) (avg-box 0.0) (avg-interval 0.0) + (n-pos 0) (n-due 0) + ;; NOTE: This has to use `list' so incf + getf works as + ;; expected + (created (list :day 0 :week 0 :month 0)) + (due (list :now 0 :day 0 :week 0 :month 0)) + (now (current-time)) + (minus-day (time-subtract now (* 24 60 60))) + (minus-week (time-subtract now (* 7 24 60 60))) + (minus-month (time-subtract now (* 30 24 60 60))) + (plus-day (time-add now (* 24 60 60))) + (plus-week (time-add now (* 7 24 60 60))) + (plus-month (time-add now (* 30 24 60 60)))) + (dolist (card index) + (cl-incf total 1) + (if (plist-get card :suspended) + (cl-incf suspended 1) + (let ((card-created (plist-get card :created))) + + (if (time-less-p minus-day card-created) + (cl-incf (cl-getf created :day) 1)) + (if (time-less-p minus-week card-created) + (cl-incf (cl-getf created :week) 1)) + (if (time-less-p minus-month card-created) + (cl-incf (cl-getf created :month) 1)) + + (dolist (pos (plist-get card :positions)) + (cl-incf n-pos 1) + + (let ((pos-due (plist-get pos :due))) + (if (time-less-p pos-due now) + (cl-incf (cl-getf due :now) 1)) + (if (time-less-p pos-due plus-day) + (cl-incf (cl-getf due :day) 1)) + (if (time-less-p pos-due plus-week) + (cl-incf (cl-getf due :week) 1)) + (if (time-less-p pos-due plus-month) + (cl-incf (cl-getf due :month) 1))) + + (cl-incf avg-ease (plist-get pos :ease)) + (cl-incf avg-box (plist-get pos :box)) + (cl-incf avg-interval (plist-get pos :interval))))) + (cl-incf (gethash (plist-get card :type) by-type 0) 1)) + (list :total total + :suspended suspended + :due due + :by-type (org-fc-dashboard--hashtable-to-alist by-type) + :created created + :avg-ease (/ avg-ease n-pos) + :avg-box (/ avg-box n-pos) + :avg-interval (/ avg-interval n-pos)))) + +;;; Bar Chart Generation + +(defun org-fc-dashboard-bar-chart (stat) + "Generate a svg bar-chart for the plist STAT." + (let* ((width org-fc-dashboard-bar-chart-width) + (height org-fc-dashboard-bar-chart-height) + (fontsize (floor (* height 0.6))) + (total (float (plist-get stat :total))) + (pos 0) + (values + `((,(/ (plist-get stat :again) total) . "red") + (,(/ (plist-get stat :hard) total) . "yellow") + (,(/ (plist-get stat :good) total) . "green") + (,(/ (plist-get stat :easy) total) . "darkgreen"))) + (svg (svg-create width height))) + (dolist (value values) + (svg-rectangle svg pos 0 (* width (car value)) height :fill (cdr value)) + (if (> (* width (car value)) (* 2 fontsize)) + (svg-text svg (format "%.1f" (* 100 (car value))) + :font-size fontsize + :fill "white" + :font-weight "bold" + :font-family "sans-serif" + :x (+ pos 5) + :y (+ fontsize (floor (- height fontsize) 2)))) + (setq pos (+ pos (* width (car value))))) + (svg-image svg))) + +(defun org-fc-dashboard-text-bar-chart (stat) + "Generate a text bar-chart for the plist STAT." + (cl-flet ((colored-bar (length color) + (propertize + (make-string length ?\s) + 'font-lock-face `(:background ,color)))) + (let* ((width org-fc-dashboard-text-bar-chart-width) + (total (float (plist-get stat :total))) + (again (floor (* width (/ (plist-get stat :again) total)))) + (hard (floor (* width (/ (plist-get stat :hard) total)))) + (good (floor (* width (/ (plist-get stat :good) total)))) + ;; Make sure to use the total width + (easy (- width again hard good))) + (concat + (colored-bar again "red") + (colored-bar hard "yellow") + (colored-bar good "green") + (colored-bar easy "blue"))))) + +;;; Main View + +;; Based on `mu4e-main-view-real' +(defun org-fc-dashboard-view (context) + "Show the dashboard view for CONTEXT in the current buffer." + (let* ((buf (get-buffer-create org-fc-dashboard-buffer-name)) + (inhibit-read-only t) + (index (org-fc-index context)) + (stats (org-fc-dashboard-stats index)) + (created-stats (plist-get stats :created)) + (due-stats (plist-get stats :due)) + (reviews-stats (org-fc-awk-stats-reviews))) + (with-current-buffer buf + (erase-buffer) + + (insert + (propertize "Card Statistics\n\n" 'face 'org-level-1)) + + (insert (format " New: %d (day) %d (week) %d (month) \n" + (plist-get created-stats :day) + (plist-get created-stats :week) + (plist-get created-stats :month))) + + (insert "\n") + (insert (format + " %6d Cards, %d suspended\n" + (plist-get stats :total) + (plist-get stats :suspended))) + (dolist (pair (plist-get stats :by-type)) + (insert (format " %6d %s\n" (cdr pair) (car pair)))) + (insert "\n") + (insert + (propertize "Position Statistics\n\n" 'face 'org-level-1)) + + (insert (format " Due: %d (now) %d (day) %d (week) %d (month)\n\n" + (plist-get due-stats :now) + (plist-get due-stats :day) + (plist-get due-stats :week) + (plist-get due-stats :month))) + + (dolist (position '((:avg-ease . "Avg. Ease") + (:avg-box . "Avg. Box") + (:avg-interval . "Avg. Interval (days)"))) + (insert + (format " %6.2f %s\n" + (plist-get stats (car position)) + (cdr position)))) + + (insert "\n") + + (when reviews-stats + (insert + (propertize "Review Statistics (All Cards)\n\n" 'face 'org-level-1)) + + (dolist (scope '((:day . "Day") + (:week . "Week") + (:month . "Month") + (:all . "All"))) + (when-let (stat (plist-get reviews-stats (car scope))) + (when (> (plist-get stat :total) 0) + (insert " ") + (if (and (display-graphic-p) + (memq 'svg (and (boundp 'image-types) image-types))) + (insert-image (org-fc-dashboard-bar-chart stat)) + (insert (org-fc-dashboard-text-bar-chart stat))) + (insert (propertize (format " %s (%d)\n\n" (cdr scope) (plist-get stat :total)) 'face 'org-level-1)) + ))) + (insert "\n")) + (insert + (propertize "[r] Review\n" 'face 'org-level-1)) + (insert + (propertize "[q] Quit\n" 'face 'org-level-1))))) + +;;; Dashboard Mode + +(defun org-fc-dashboard-review () + "Review the context of the current dashboard." + (interactive) + (org-fc-review org-fc-dashboard-context)) + +(defvar org-fc-dashboard-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "r") 'org-fc-dashboard-review) + (define-key map (kbd "q") 'quit-window) + (define-key map (kbd "G") 'org-fc-dashboard-view) + map)) + +(define-derived-mode org-fc-dashboard-mode special-mode "org-fc main" + "Major mode providing an overview of the flashcard system" + (set (make-local-variable 'revert-buffer-function) #'org-fc-dashboard-view) + (setq-local cursor-type nil)) + +;;;###autoload +(defun org-fc-dashboard (context) + "Open a buffer showing the dashboard view for CONTEXT." + (interactive (list (org-fc-select-context))) + (setq org-fc-context-dashboard context) + (org-fc-dashboard-view context) + (switch-to-buffer org-fc-dashboard-buffer-name) + (goto-char (point-min)) + (org-fc-dashboard-mode)) + +;;; Footer + +(provide 'org-fc-dashboard) + +;;; org-fc-dashboard.el ends here @@ -121,30 +121,6 @@ types." :type 'integer :group 'org-fc) -;;;; Dashboard - -(defcustom org-fc-dashboard-bar-chart-width 400 - "Width of the svg generated to display review statistics." - :type 'integer - :group 'org-fc) - -(defcustom org-fc-dashboard-bar-chart-height 20 - "Height of the svg generated to display review statistics." - :type 'integer - :group 'org-fc) - -(defcustom org-fc-dashboard-text-bar-chart-width 40 - "Width of the text-bar chart used to display review statistics. -This is only used org-fc is run in a non-graphic display -environment without svg support." - :type 'integer - :group 'org-fc) - -(defcustom org-fc-dashboard-buffer-name "*org-fc Main*" - "Name of the buffer to use for displaying the dashboard view." - :type 'string - :group 'org-fc) - ;;;; Spacing Parameters (defcustom org-fc-algorithm 'sm2-v1 @@ -1240,8 +1216,6 @@ removed." "Default context for all cards.") (defvar org-fc-context-buffer '(:paths buffer) "Default context for the current buffer.") -(defvar org-fc-context-dashboard org-fc-context-all - "Context of the current dashboard view.") (defun org-fc-contexts () "List of all contexts." @@ -1305,11 +1279,6 @@ Valid contexts: (interactive) (org-fc-review org-fc-context-all)) -(defun org-fc-review-dashboard-context () - "Review the context of the current dashboard." - (interactive) - (org-fc-review org-fc-context-dashboard)) - (defun org-fc-review-next-card (&optional resuming) "Review the next card of the current session. If RESUMING is non-nil, some parts of the buffer setup are skipped." @@ -1528,210 +1497,7 @@ Pauses the review, unnarrows the buffer and activates ;;; Dashboard -(defun org-fc--hashtable-to-alist (ht) - "Convert a hash-table HT to an alist." - (let (res) - (dolist (key (hash-table-keys ht)) - (push (cons key (gethash key ht)) res)) - res)) - -(defun org-fc-stats (index) - "Compute statistics for an INDEX of cards and positions." - (let* ((total 0) (suspended 0) - (by-type (make-hash-table)) - (avg-ease 0.0) (avg-box 0.0) (avg-interval 0.0) - (n-pos 0) (n-due 0) - ;; NOTE: This has to use `list' so incf + getf works as - ;; expected - (created (list :day 0 :week 0 :month 0)) - (due (list :now 0 :day 0 :week 0 :month 0)) - (now (current-time)) - (minus-day (time-subtract now (* 24 60 60))) - (minus-week (time-subtract now (* 7 24 60 60))) - (minus-month (time-subtract now (* 30 24 60 60))) - (plus-day (time-add now (* 24 60 60))) - (plus-week (time-add now (* 7 24 60 60))) - (plus-month (time-add now (* 30 24 60 60)))) - (dolist (card index) - (cl-incf total 1) - (if (plist-get card :suspended) - (cl-incf suspended 1) - (let ((card-created (plist-get card :created))) - - (if (time-less-p minus-day card-created) - (cl-incf (cl-getf created :day) 1)) - (if (time-less-p minus-week card-created) - (cl-incf (cl-getf created :week) 1)) - (if (time-less-p minus-month card-created) - (cl-incf (cl-getf created :month) 1)) - - (dolist (pos (plist-get card :positions)) - (cl-incf n-pos 1) - - (let ((pos-due (plist-get pos :due))) - (if (time-less-p pos-due now) - (cl-incf (cl-getf due :now) 1)) - (if (time-less-p pos-due plus-day) - (cl-incf (cl-getf due :day) 1)) - (if (time-less-p pos-due plus-week) - (cl-incf (cl-getf due :week) 1)) - (if (time-less-p pos-due plus-month) - (cl-incf (cl-getf due :month) 1))) - - (cl-incf avg-ease (plist-get pos :ease)) - (cl-incf avg-box (plist-get pos :box)) - (cl-incf avg-interval (plist-get pos :interval))))) - (cl-incf (gethash (plist-get card :type) by-type 0) 1)) - (list :total total - :suspended suspended - :due due - :by-type (org-fc--hashtable-to-alist by-type) - :created created - :avg-ease (/ avg-ease n-pos) - :avg-box (/ avg-box n-pos) - :avg-interval (/ avg-interval n-pos)))) - -;;;; Bar Chart Generation - -(defun org-fc-dashboard-bar-chart (stat) - "Generate a svg bar-chart for the plist STAT." - (let* ((width org-fc-dashboard-bar-chart-width) - (height org-fc-dashboard-bar-chart-height) - (fontsize (floor (* height 0.6))) - (total (float (plist-get stat :total))) - (pos 0) - (values - `((,(/ (plist-get stat :again) total) . "red") - (,(/ (plist-get stat :hard) total) . "yellow") - (,(/ (plist-get stat :good) total) . "green") - (,(/ (plist-get stat :easy) total) . "darkgreen"))) - (svg (svg-create width height))) - (dolist (value values) - (svg-rectangle svg pos 0 (* width (car value)) height :fill (cdr value)) - (if (> (* width (car value)) (* 2 fontsize)) - (svg-text svg (format "%.1f" (* 100 (car value))) - :font-size fontsize - :fill "white" - :font-weight "bold" - :font-family "sans-serif" - :x (+ pos 5) - :y (+ fontsize (floor (- height fontsize) 2)))) - (setq pos (+ pos (* width (car value))))) - (svg-image svg))) - -(defun org-fc-dashboard-text-bar-chart (stat) - "Generate a text bar-chart for the plist STAT." - (cl-flet ((colored-bar (length color) - (propertize - (make-string length ?\s) - 'font-lock-face `(:background ,color)))) - (let* ((width org-fc-dashboard-text-bar-chart-width) - (total (float (plist-get stat :total))) - (again (floor (* width (/ (plist-get stat :again) total)))) - (hard (floor (* width (/ (plist-get stat :hard) total)))) - (good (floor (* width (/ (plist-get stat :good) total)))) - ;; Make sure to use the total width - (easy (- width again hard good))) - (concat - (colored-bar again "red") - (colored-bar hard "yellow") - (colored-bar good "green") - (colored-bar easy "blue"))))) - -;;;; Main View - -;; Based on `mu4e-main-view-real' -(defun org-fc-dashboard-view (context) - "Show the dashboard view for CONTEXT in the current buffer." - (let* ((buf (get-buffer-create org-fc-dashboard-buffer-name)) - (inhibit-read-only t) - (index (org-fc-index context)) - (stats (org-fc-stats index)) - (created-stats (plist-get stats :created)) - (due-stats (plist-get stats :due)) - (reviews-stats (org-fc-awk-stats-reviews))) - (with-current-buffer buf - (erase-buffer) - - (insert - (propertize "Card Statistics\n\n" 'face 'org-level-1)) - - (insert (format " New: %d (day) %d (week) %d (month) \n" - (plist-get created-stats :day) - (plist-get created-stats :week) - (plist-get created-stats :month))) - - (insert "\n") - (insert (format - " %6d Cards, %d suspended\n" - (plist-get stats :total) - (plist-get stats :suspended))) - (dolist (pair (plist-get stats :by-type)) - (insert (format " %6d %s\n" (cdr pair) (car pair)))) - (insert "\n") - (insert - (propertize "Position Statistics\n\n" 'face 'org-level-1)) - - (insert (format " Due: %d (now) %d (day) %d (week) %d (month)\n\n" - (plist-get due-stats :now) - (plist-get due-stats :day) - (plist-get due-stats :week) - (plist-get due-stats :month))) - - (dolist (position '((:avg-ease . "Avg. Ease") - (:avg-box . "Avg. Box") - (:avg-interval . "Avg. Interval (days)"))) - (insert - (format " %6.2f %s\n" - (plist-get stats (car position)) - (cdr position)))) - - (insert "\n") - - (when reviews-stats - (insert - (propertize "Review Statistics (All Cards)\n\n" 'face 'org-level-1)) - - (dolist (scope '((:day . "Day") - (:week . "Week") - (:month . "Month") - (:all . "All"))) - (when-let (stat (plist-get reviews-stats (car scope))) - (when (> (plist-get stat :total) 0) - (insert " ") - (if (and (display-graphic-p) - (memq 'svg (and (boundp 'image-types) image-types))) - (insert-image (org-fc-dashboard-bar-chart stat)) - (insert (org-fc-dashboard-text-bar-chart stat))) - (insert (propertize (format " %s (%d)\n\n" (cdr scope) (plist-get stat :total)) 'face 'org-level-1)) - ))) - (insert "\n")) - (insert - (propertize "[r] Review\n" 'face 'org-level-1)) - (insert - (propertize "[q] Quit\n" 'face 'org-level-1))))) - -(defvar org-fc-dashboard-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "r") 'org-fc-review-dashboard-context) - (define-key map (kbd "q") 'quit-window) - (define-key map (kbd "G") 'org-fc-dashboard-view) - map)) - -(define-derived-mode org-fc-dashboard-mode special-mode "org-fc main" - "Major mode providing an overview of the flashcard system" - (set (make-local-variable 'revert-buffer-function) #'org-fc-dashboard-view) - (setq-local cursor-type nil)) - -;;;###autoload -(defun org-fc-dashboard (context) - "Open a buffer showing the dashboard view for CONTEXT." - (interactive (list (org-fc-select-context))) - (setq org-fc-context-dashboard context) - (org-fc-dashboard-view context) - (switch-to-buffer org-fc-dashboard-buffer-name) - (goto-char (point-min)) - (org-fc-dashboard-mode)) +(require 'org-fc-dashboard) ;;; Footer |