diff options
| -rw-r--r-- | org-drill.el | 127 | ||||
| -rw-r--r-- | tests/test-org-drill-statistics-render-attention.el | 12 | ||||
| -rw-r--r-- | tests/test-org-drill-statistics-source-buffer.el | 174 |
3 files changed, 274 insertions, 39 deletions
diff --git a/org-drill.el b/org-drill.el index 11f161e..8c895b6 100644 --- a/org-drill.el +++ b/org-drill.el @@ -5003,9 +5003,11 @@ an integer (0 when absent). AVG-QUALITY is DRILL_AVERAGE_QUALITY as a float, or nil when absent. DAYS-SINCE-REVIEW is the integer day count since DRILL_LAST_REVIEWED, or nil when never reviewed. DAYS-SINCE-ADDED is the integer day count since DATE_ADDED, or nil when absent. -TOTAL-REPEATS is DRILL_TOTAL_REPEATS as an integer (0 when absent)." +TOTAL-REPEATS is DRILL_TOTAL_REPEATS as an integer (0 when absent). +FILE is the file the entry's buffer visits, or nil for a fileless +buffer; card links carry it so the dashboard can jump across files." heading pos failure-count avg-quality - days-since-review days-since-added total-repeats) + days-since-review days-since-added total-repeats file) ;; Short aliases for the long struct accessors, used by the sort ;; comparators below so the comparator lines stay readable. @@ -5057,7 +5059,8 @@ via `org-get-heading', so the point must be on a drill heading." (org-drill-statistics--days-since-org-timestamp last-raw today-day) :days-since-added (org-drill-statistics--days-since-org-timestamp added-raw today-day) - :total-repeats (if repeats-raw (string-to-number repeats-raw) 0)))) + :total-repeats (if repeats-raw (string-to-number repeats-raw) 0) + :file (buffer-file-name)))) (defun org-drill-statistics--days-since-org-timestamp (timestamp today-day) "Return integer days from org TIMESTAMP string to TODAY-DAY. @@ -5266,25 +5269,51 @@ with no SCHEDULED time are ignored." ;; each scan and cap) gives the pre-cap totals needed for the "+N more" ;; footers for free. -(defun org-drill-statistics--card-link (heading pos) +(defun org-drill-statistics--card-link (heading pos &optional file) "Return an org bracket link to a drill card heading. HEADING is the card's outline heading string, used as the link -description. POS is the integer buffer position of the heading, carried -in the link path so the dashboard's RET handler can jump to the card. -The path has the form \"org-drill-card:POS\". Any closing bracket in -HEADING is replaced so a literal \"]]\" cannot terminate the link early. -An empty or nil HEADING falls back to a position-based description." +description. POS is the integer buffer position of the heading. FILE +is the file the card's buffer visits, or nil for a fileless buffer. +The path has the form \"org-drill-card:POS@FILE\" (FILE may be empty), +so the follow handler can jump to the card even across files. Any +closing bracket in HEADING is replaced so a literal \"]]\" cannot +terminate the link early. An empty or nil HEADING falls back to a +position-based description." (let* ((desc (if (and heading (not (string-empty-p heading))) heading (format "card at %d" pos))) (safe (replace-regexp-in-string "]" "}" desc))) - (format "[[org-drill-card:%d][%s]]" pos safe))) + (format "[[org-drill-card:%d@%s][%s]]" pos (or file "") safe))) + +(defun org-drill-statistics--follow-card-link (path &optional _prefix) + "Follow an org-drill-card link to its card. +PATH is \"POS@FILE\" (FILE may be empty) or a legacy bare \"POS\". +With a file, visit it in another window and move point to POS. Without +one, fall back to the dashboard's stored source buffer. Signals a +`user-error' when neither identifies a live target." + (let* ((at (string-match "@" path)) + (pos (string-to-number (if at (substring path 0 at) path))) + (file (and at (substring path (1+ at)))) + (source (and (boundp 'org-drill-statistics--source-buffer) + org-drill-statistics--source-buffer))) + (cond + ((and file (not (string-empty-p file))) + (find-file-other-window file) + (goto-char (min (max 1 pos) (point-max)))) + ((buffer-live-p source) + (pop-to-buffer source) + (goto-char (min (max 1 pos) (point-max)))) + (t (user-error + "Card buffer is gone; refresh the dashboard from a deck buffer"))))) + +(org-link-set-parameters "org-drill-card" + :follow #'org-drill-statistics--follow-card-link) (defun org-drill-statistics--render-attention-table (title rows total empty-note) "Render one needs-attention subsection as an org string. TITLE is the third-level heading text for the subsection. ROWS is a -list of (HEADING . POS) cons cells, already capped at +list of (HEADING POS FILE) lists, already capped at `org-drill-statistics-attention-row-limit' and already sorted. TOTAL is the full count of matching cards before capping, used for the \"+N more\" footer. EMPTY-NOTE is the line shown when ROWS is empty. @@ -5304,7 +5333,8 @@ the number of rows shown." (mapconcat (lambda (row) (format "| %s |" - (org-drill-statistics--card-link (car row) (cdr row)))) + (org-drill-statistics--card-link + (nth 0 row) (nth 1 row) (nth 2 row)))) rows "\n") "\n" @@ -5368,8 +5398,9 @@ pre-cap totals are available for the footers without rescanning." (lambda (structs) (mapcar (lambda (d) - (cons (org-drill-statistics--entry-attention-data-heading d) - (org-drill-statistics--entry-attention-data-pos d))) + (list (org-drill-statistics--entry-attention-data-heading d) + (org-drill-statistics--entry-attention-data-pos d) + (org-drill-statistics--entry-attention-data-file d))) (org-drill-statistics--cap-rows structs))))) (concat "** Needs attention\n" @@ -5634,6 +5665,14 @@ algorithms. Set by `org-drill-statistics' and rotated by `org-drill-statistics-cycle-algorithm'. Read by the render helpers via the filtered log they are handed.") +(defvar-local org-drill-statistics--source-buffer nil + "Buffer-local deck buffer the dashboard's card scans run in. +Set by `org-drill-statistics' to the buffer the command was invoked +from and read by `org-drill-statistics--render' (via refresh and the +cycle commands) so every card traversal sees the deck, not the +dashboard's own text. Also the fallback jump target for card links +whose path carries no file.") + (defun org-drill-statistics--range-cutoff-float (label) "Return the float-time cutoff for range LABEL, or nil for all time. LABEL is a key in `org-drill-statistics-range-presets'. When its DAYS @@ -5720,24 +5759,34 @@ is put in `org-mode'; not intended to be toggled by hand." :lighter " OrgDrillStats" :keymap org-drill-statistics-mode-map) -(defun org-drill-statistics--render (buffer scope range algorithm) +(defun org-drill-statistics--render (buffer scope range algorithm + &optional source) "Render the dashboard for SCOPE, RANGE, ALGORITHM into BUFFER. -BUFFER is the target buffer. Its read-only state is lifted for the -write, the assembled body replaces the contents, point returns to the -top, and the buffer is left read-only. The three filter values are -stored buffer-locally so refresh and the cycle commands can read and -rotate them. Returns BUFFER." - (with-current-buffer buffer - (let ((inhibit-read-only t) - (body (org-drill-statistics--render-all scope range algorithm))) - (erase-buffer) - (insert body) - (goto-char (point-min))) - (setq org-drill-statistics--scope scope - org-drill-statistics--range range - org-drill-statistics--algorithm algorithm) - (setq buffer-read-only t) - buffer)) +BUFFER is the target buffer. SOURCE is the deck buffer the card scans +run in, defaulting to the current buffer, so the traversals see the +deck rather than the dashboard's own text. A dead SOURCE signals a +`user-error'. BUFFER's read-only state is lifted for the write, the +assembled body replaces the contents, point returns to the top, and the +buffer is left read-only. The filter values and SOURCE are stored +buffer-locally so refresh and the cycle commands can read and rotate +them. Returns BUFFER." + (let ((source (or source (current-buffer)))) + (unless (buffer-live-p source) + (user-error + "The dashboard's deck buffer is gone; run org-drill-statistics from a deck")) + (let ((body (with-current-buffer source + (org-drill-statistics--render-all scope range algorithm)))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert body) + (goto-char (point-min))) + (setq org-drill-statistics--scope scope + org-drill-statistics--range range + org-drill-statistics--algorithm algorithm + org-drill-statistics--source-buffer source) + (setq buffer-read-only t) + buffer)))) ;;;###autoload (defun org-drill-statistics () @@ -5748,13 +5797,14 @@ filter header and the five render sections, using the current to it. Refresh and the s/r/a cycle commands re-render in place." (interactive) (let ((buffer (get-buffer-create org-drill-statistics--buffer-name)) + (source (current-buffer)) (scope org-drill-scope) (range (caar org-drill-statistics-range-presets)) (algorithm nil)) (with-current-buffer buffer (org-mode) (org-drill-statistics-mode 1)) - (org-drill-statistics--render buffer scope range algorithm) + (org-drill-statistics--render buffer scope range algorithm source) (switch-to-buffer buffer) buffer)) @@ -5767,7 +5817,8 @@ every section against the current log and card state. Bound to g." (current-buffer) org-drill-statistics--scope org-drill-statistics--range - org-drill-statistics--algorithm)) + org-drill-statistics--algorithm + org-drill-statistics--source-buffer)) (defun org-drill-statistics-cycle-scope () "Cycle the dashboard scope filter and refresh. @@ -5990,7 +6041,15 @@ do. Interactively, prompts for DIRECTORY." (org-drill-statistics--write-csv (expand-file-name "cards.csv" directory) org-drill-statistics--cards-csv-header - (org-drill-statistics--cards-rows scope)) + (let ((source org-drill-statistics--source-buffer)) + (cond + ((buffer-live-p source) + (with-current-buffer source + (org-drill-statistics--cards-rows scope))) + (source + (user-error + "The dashboard's deck buffer is gone; refresh from a deck first")) + (t (org-drill-statistics--cards-rows scope))))) (org-drill-statistics--write-csv (expand-file-name "daily.csv" directory) org-drill-statistics--daily-csv-header diff --git a/tests/test-org-drill-statistics-render-attention.el b/tests/test-org-drill-statistics-render-attention.el index b3f2375..4adcfcc 100644 --- a/tests/test-org-drill-statistics-render-attention.el +++ b/tests/test-org-drill-statistics-render-attention.el @@ -65,8 +65,9 @@ current time so the fixture never hardcodes today." (test-org-drill-stats--attn-fixture) (let ((out (org-drill-statistics--render-attention 'file))) (should (string-match-p "| Card |" out)) - (should (string-match-p "\\[\\[org-drill-card:[0-9]+\\]\\[Leech 00\\]\\]" - out))))) + (should (string-match-p + "\\[\\[org-drill-card:[0-9]+@[^]]*\\]\\[Leech 00\\]\\]" + out))))) (ert-deftest test-org-drill-statistics-attention-cap-and-footer () "Twelve leeches over a 10 cap show 10 rows and a +2 more footer." @@ -126,15 +127,16 @@ current time so the fixture never hardcodes today." (ert-deftest test-org-drill-statistics-card-link-sanitizes-brackets () "Closing brackets in a heading cannot terminate the link early." (let ((link (org-drill-statistics--card-link "a]] b" 42))) - (should (string-prefix-p "[[org-drill-card:42][" link)) + (should (string-prefix-p "[[org-drill-card:42@][" link)) (should (string-suffix-p "]]" link)) (should-not (string-match-p "a]] b" link)))) (ert-deftest test-org-drill-statistics-card-link-empty-heading-fallback () "An empty heading falls back to a position-based description." (let ((link (org-drill-statistics--card-link "" 99))) - (should (string-match-p "\\[\\[org-drill-card:99\\]\\[card at 99\\]\\]" - link)))) + (should (string-match-p + "\\[\\[org-drill-card:99@[^]]*\\]\\[card at 99\\]\\]" + link)))) (provide 'test-org-drill-statistics-render-attention) diff --git a/tests/test-org-drill-statistics-source-buffer.el b/tests/test-org-drill-statistics-source-buffer.el new file mode 100644 index 0000000..5732b63 --- /dev/null +++ b/tests/test-org-drill-statistics-source-buffer.el @@ -0,0 +1,174 @@ +;;; test-org-drill-statistics-source-buffer.el --- Dashboard source-buffer tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the statistics dashboard's source-buffer plumbing and +;; the org-drill-card link type. The dashboard must scan the deck the +;; command was invoked from, not its own buffer, and its card links must +;; be followable. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'org) + +(defmacro org-drill-statistics-source-test--with-deck (var &rest body) + "Run BODY with VAR bound to a live org deck buffer holding two drill cards." + (declare (indent 1)) + `(let ((,var (generate-new-buffer "*source-deck*"))) + (unwind-protect + (with-current-buffer ,var + (org-mode) + (insert "* Card one :drill:\nBody one.\n" + "* Card two :drill:\nBody two.\n") + (goto-char (point-min)) + ,@body) + (when (buffer-live-p ,var) (kill-buffer ,var))))) + +;;; Normal cases + +(ert-deftest test-org-drill-statistics-render-counts-source-deck-cards () + "Rendering into the dashboard counts the cards of the source deck. +With the default file scope, the card scans must run in the source +buffer, not the dashboard buffer being rendered into." + (org-drill-statistics-source-test--with-deck deck + (let ((dash (generate-new-buffer "*dash-test*")) + (org-drill-scope 'file) + (org-drill-session-log nil)) + (unwind-protect + (progn + (with-current-buffer dash (org-mode)) + (org-drill-statistics--render dash 'file "last 90d" nil deck) + (with-current-buffer dash + (goto-char (point-min)) + ;; Overview table data row: | total | new | mature | lapsed | + (should (search-forward "| 2 | " nil t)))) + (kill-buffer dash))))) + +(ert-deftest test-org-drill-statistics-refresh-uses-stored-source () + "Refresh from inside the dashboard re-scans the stored source deck." + (org-drill-statistics-source-test--with-deck deck + (let ((dash (generate-new-buffer "*dash-test*")) + (org-drill-scope 'file) + (org-drill-session-log nil)) + (unwind-protect + (progn + (with-current-buffer dash (org-mode)) + (org-drill-statistics--render dash 'file "last 90d" nil deck) + (with-current-buffer dash + (org-drill-statistics-refresh) + (goto-char (point-min)) + (should (search-forward "| 2 | " nil t)))) + (kill-buffer dash))))) + +(ert-deftest test-org-drill-statistics-card-link-type-is-registered () + "The org-drill-card link type has a follow handler registered." + (should (functionp (org-link-get-parameter "org-drill-card" :follow)))) + +(ert-deftest test-org-drill-statistics-card-link-encodes-file () + "Card links carry the file identity after the position." + (let ((link (org-drill-statistics--card-link "Heading" 42 "/tmp/deck.org"))) + (should (string-prefix-p "[[org-drill-card:42@/tmp/deck.org][" link)))) + +(ert-deftest test-org-drill-statistics-follow-jumps-to-file-position () + "Following a card link visits the file and moves point to the position." + (let* ((file (make-temp-file "org-drill-follow-test" nil ".org" + "* Card one :drill:\nBody.\n")) + (buf nil)) + (unwind-protect + (progn + (org-drill-statistics--follow-card-link (format "1@%s" file)) + (setq buf (current-buffer)) + (should (equal (buffer-file-name) file)) + (should (= (point) 1))) + (when (and buf (buffer-live-p buf)) (kill-buffer buf)) + (delete-file file)))) + +;;; Boundary cases + +(ert-deftest test-org-drill-statistics-render-empty-deck-counts-zero () + "An empty source deck renders a zero-card overview, not an error." + (let ((deck (generate-new-buffer "*empty-deck*")) + (dash (generate-new-buffer "*dash-test*")) + (org-drill-scope 'file) + (org-drill-session-log nil)) + (unwind-protect + (progn + (with-current-buffer deck (org-mode)) + (with-current-buffer dash (org-mode)) + (org-drill-statistics--render dash 'file "last 90d" nil deck) + (with-current-buffer dash + (goto-char (point-min)) + (should (search-forward "| 0 | " nil t)))) + (kill-buffer deck) + (kill-buffer dash)))) + +(ert-deftest test-org-drill-statistics-card-link-empty-file-omits-identity () + "A card link built with no file still carries the position." + (let ((link (org-drill-statistics--card-link "Heading" 7 nil))) + (should (string-prefix-p "[[org-drill-card:7@][" link)))) + +(ert-deftest test-org-drill-statistics-export-cards-from-source-deck () + "CSV export scans the stored source deck, not the dashboard buffer." + (org-drill-statistics-source-test--with-deck deck + (let ((dash (generate-new-buffer "*dash-test*")) + (dir (make-temp-file "org-drill-export-test" t)) + (org-drill-scope 'file) + (org-drill-session-log nil)) + (unwind-protect + (progn + (with-current-buffer dash (org-mode)) + (org-drill-statistics--render dash 'file "last 90d" nil deck) + (with-current-buffer dash + (org-drill-statistics-export-csv dir)) + (with-temp-buffer + (insert-file-contents (expand-file-name "cards.csv" dir)) + ;; Header plus one row per deck card. + (should (= 3 (count-lines (point-min) (point-max)))))) + (kill-buffer dash) + (delete-directory dir t))))) + +(ert-deftest test-org-drill-statistics-follow-clamps-position-floor () + "A zero or garbage position clamps to buffer start instead of erroring." + (let* ((file (make-temp-file "org-drill-follow-clamp" nil ".org" + "* Card :drill:\n")) + (buf nil)) + (unwind-protect + (progn + (org-drill-statistics--follow-card-link (format "0@%s" file)) + (setq buf (current-buffer)) + (should (= (point) 1))) + (when (and buf (buffer-live-p buf)) (kill-buffer buf)) + (delete-file file)))) + +;;; Error cases + +(ert-deftest test-org-drill-statistics-refresh-dead-source-signals-user-error () + "Refresh after the source deck is killed signals a clear user-error." + (let ((dash (generate-new-buffer "*dash-test*")) + (deck (generate-new-buffer "*doomed-deck*")) + (org-drill-scope 'file) + (org-drill-session-log nil)) + (unwind-protect + (progn + (with-current-buffer deck + (org-mode) + (insert "* Card :drill:\n")) + (with-current-buffer dash (org-mode)) + (org-drill-statistics--render dash 'file "last 90d" nil deck) + (kill-buffer deck) + (with-current-buffer dash + (should-error (org-drill-statistics-refresh) + :type 'user-error))) + (when (buffer-live-p deck) (kill-buffer deck)) + (kill-buffer dash)))) + +(ert-deftest test-org-drill-statistics-follow-dead-source-signals-user-error () + "Following a bufferless link with no live source signals a user-error." + (with-temp-buffer + ;; No dashboard source var set in this buffer; empty file identity. + (should-error (org-drill-statistics--follow-card-link "5@") + :type 'user-error))) + +(provide 'test-org-drill-statistics-source-buffer) +;;; test-org-drill-statistics-source-buffer.el ends here |