feat(dirvish): start org-drill on the .org file at point with S

`S` ("study") in `dirvish-mode-map` opens the `.org` file at point and runs `cj/drill-this-file` on it, so I can drill any deck straight from the file list. It `user-error`s on no file, on a directory, or on a non-`.org` file.

`D` and `O` were already taken (duplicate-file, open-with-command), so I went with `S`. It shadows dired's `dired-do-symlink`, which I never use from dirvish and which stays on `M-x` anyway. New `tests/test-dirvish-config-drill.el`: 6 ERT tests with `dired-get-filename`, `find-file`, and `cj/drill-this-file` mocked. I also fixed the stale `P` line in the module commentary — `P` is the print command now, not copy-path.

2 files changed, 103 insertions, 1 deletions

diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el
index b25baca9..5f5ca7fc 100644
--- a/modules/dirvish-config.el
+++ b/modules/dirvish-config.el
@@ -16,7 +16,8 @@
 ;; - o/O: Open file with xdg-open/custom command
 ;; - l: Copy org-link with relative file path (project-relative or home-relative)
 ;; - p: Copy absolute file path
-;; - P: Copy relative file path (project-relative or home-relative)
+;; - P: Print the file at point via CUPS
+;; - S: Study — start an org-drill session on the .org file at point
 ;; - M-S-d (Meta-Shift-d): DWIM shell commands menu
 ;; - TAB: Toggle subtree expansion
 ;; - F11: Toggle sidebar view
@@ -29,6 +30,8 @@
 (require 'system-lib)
 (require 'external-open-lib)
 
+(declare-function cj/drill-this-file "org-drill-config")
+
 ;; mark files in dirvish, attach in mu4e
 (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode)
 
@@ -291,6 +294,18 @@ Shadows dired's `P' (`dired-do-print') with this type-aware version."
               (user-error "Print failed (exit %d)%s" code
                           (if (string-empty-p out) "" (concat ": " out))))))))))
 
+;;; ------------------------------ Dirvish Drill File ---------------------------
+
+(defun cj/dirvish-drill-file ()
+  "Open the Org file at point and start an `org-drill' session on it.
+Bound to `S' (\"study\") in `dirvish-mode-map'; refuses anything but a `.org' file."
+  (interactive)
+  (let ((file (dired-get-filename nil t)))
+    (unless (and file (not (file-directory-p file)) (string-suffix-p ".org" file t))
+      (user-error "Not an Org file at point"))
+    (find-file file)
+    (cj/drill-this-file)))
+
 ;;; ----------------------- Dirvish Open File Manager Here ----------------------
 
 (defun cj/dirvish-open-file-manager-here ()
@@ -469,6 +484,7 @@ Uses feh on X11, swww on Wayland."
    ("p"       . (lambda () (interactive) (cj/dired-copy-path-as-kill nil t)))
    ("P"       . cj/dirvish-print-file)
    ("r"       . dirvish-rsync)
+   ("S"       . cj/dirvish-drill-file)  ; Study: org-drill the .org file at point
    ("s"       . dirvish-quicksort)
    ("v"       . dirvish-vc-menu)
    ("y"       . dirvish-yank-menu)))
diff --git a/tests/test-dirvish-config-drill.el b/tests/test-dirvish-config-drill.el
new file mode 100644
index 00000000..f26de6d8
--- /dev/null
+++ b/tests/test-dirvish-config-drill.el
@@ -0,0 +1,86 @@
+;;; test-dirvish-config-drill.el --- Tests for the dirvish org-drill command -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; `cj/dirvish-drill-file' (bound to `S' in `dirvish-mode-map') opens the
+;; `.org' file at point and starts an `org-drill' session on it.  These tests
+;; mock `dired-get-filename', `find-file', and `cj/drill-this-file' and check
+;; the happy path plus the rejection paths (no file, directory, non-`.org').
+;;
+;; `cj/drill-this-file' lives in org-drill-config.el; it's stubbed here so the
+;; dirvish command can be exercised without loading the org-drill stack.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+(require 'package)
+
+(setq package-user-dir (expand-file-name "elpa" user-emacs-directory))
+(package-initialize)
+(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory))
+(add-to-list 'load-path (expand-file-name "elpa/dirvish-2.3.0/extensions"
+                                          user-emacs-directory))
+
+(unless (fboundp 'cj/drill-this-file)
+  (defun cj/drill-this-file (&rest _)
+    "Test stub; the real definition lives in org-drill-config.el."
+    nil))
+
+(require 'user-constants)
+(require 'keybindings)
+(require 'dirvish-config)
+
+(ert-deftest test-dirvish-drill-file-opens-and-drills-an-org-file ()
+  "Normal: an `.org' file at point is opened and drilled."
+  (let (opened (drilled 0))
+    (cl-letf (((symbol-function 'dired-get-filename) (lambda (&rest _) "/tmp/decks/cards.org"))
+              ((symbol-function 'find-file) (lambda (f) (setq opened f)))
+              ((symbol-function 'cj/drill-this-file) (lambda (&rest _) (cl-incf drilled))))
+      (cj/dirvish-drill-file))
+    (should (equal "/tmp/decks/cards.org" opened))
+    (should (= 1 drilled))))
+
+(ert-deftest test-dirvish-drill-file-accepts-uppercase-extension ()
+  "Boundary: the `.org' check ignores case."
+  (let (opened)
+    (cl-letf (((symbol-function 'dired-get-filename) (lambda (&rest _) "/tmp/decks/CARDS.ORG"))
+              ((symbol-function 'find-file) (lambda (f) (setq opened f)))
+              ((symbol-function 'cj/drill-this-file) #'ignore))
+      (cj/dirvish-drill-file))
+    (should (equal "/tmp/decks/CARDS.ORG" opened))))
+
+(ert-deftest test-dirvish-drill-file-rejects-non-org-file ()
+  "Error: a non-`.org' file is refused and nothing is opened or drilled."
+  (let ((opened nil) (drilled 0))
+    (cl-letf (((symbol-function 'dired-get-filename) (lambda (&rest _) "/tmp/decks/notes.txt"))
+              ((symbol-function 'find-file) (lambda (&rest _) (setq opened t)))
+              ((symbol-function 'cj/drill-this-file) (lambda (&rest _) (cl-incf drilled))))
+      (should-error (cj/dirvish-drill-file) :type 'user-error))
+    (should-not opened)
+    (should (= 0 drilled))))
+
+(ert-deftest test-dirvish-drill-file-rejects-no-file-at-point ()
+  "Error: with no file at point it raises a `user-error'."
+  (cl-letf (((symbol-function 'dired-get-filename) (lambda (&rest _) nil))
+            ((symbol-function 'find-file) (lambda (&rest _) (error "should not open")))
+            ((symbol-function 'cj/drill-this-file) (lambda (&rest _) (error "should not drill"))))
+    (should-error (cj/dirvish-drill-file) :type 'user-error)))
+
+(ert-deftest test-dirvish-drill-file-rejects-a-directory ()
+  "Boundary: a directory at point is refused even when its name ends in `.org'."
+  (let* ((parent (make-temp-file "cj-drill-dir" t))
+         (dir (expand-file-name "deck.org" parent)))
+    (make-directory dir)
+    (unwind-protect
+        (cl-letf (((symbol-function 'dired-get-filename) (lambda (&rest _) dir))
+                  ((symbol-function 'find-file) (lambda (&rest _) (error "should not open")))
+                  ((symbol-function 'cj/drill-this-file) (lambda (&rest _) (error "should not drill"))))
+          (should-error (cj/dirvish-drill-file) :type 'user-error))
+      (delete-directory parent t))))
+
+(ert-deftest test-dirvish-drill-file-keymap-binding ()
+  "Normal: `S' in `dirvish-mode-map' runs the drill command."
+  (should (eq (keymap-lookup dirvish-mode-map "S") #'cj/dirvish-drill-file)))
+
+(provide 'test-dirvish-config-drill)
+;;; test-dirvish-config-drill.el ends here