aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-04-30 00:30:36 -0500
committerCraig Jennings <c@cjennings.net>2026-04-30 00:30:36 -0500
commit5b5ac68e138950e2f8d502e22350a62570da88a6 (patch)
tree81c27f9ff1d3d3e7443f3fcfc9785d9df7f04c29
parente7938e9193ba1a39aab0e614bb3bf682508685b2 (diff)
downloadgloss-5b5ac68e138950e2f8d502e22350a62570da88a6.tar.gz
gloss-5b5ac68e138950e2f8d502e22350a62570da88a6.zip
feat: implement gloss-drill org-drill export
Two public commands plus a small helper. `gloss-drill-export-all' walks `gloss-file' via `org-map-entries' and adds `:drill:' tag and `DRILL_CARD_TYPE: twosided' property to every top-level entry. Membership and equality guards make the operation idempotent: re-running adds nothing and writes nothing. `gloss-drill-untag-all' is the reverse, and intentionally does not require `org-drill' to be installed (the user might be cleaning up after uninstalling). The walking logic factors into a single private helper `gloss-drill--map-entries' that handles file open, modtime verification, org-mode activation, the level-1 filter, and a write-only-if-modified save. Both public commands compose it with their respective per-entry mutators. `org-drill' presence is checked with `featurep' before any walk so the file is never touched when the dep is missing. The user-error message includes the install command. Folds in a small fix to the idempotency test helper: the original used `throw' from inside `org-map-entries' but did not return the count to the caller. Switched to `catch' / `throw' with the count as the throw value. 98 tests pass in 0.24s — 88 prior plus 10 new across the four scenarios named in the design doc (tags-untagged, skips-already-tagged, no-orgdrill-installed, untag-all).
-rw-r--r--gloss-drill.el73
-rw-r--r--tests/test-gloss-drill--export-all-skips-already-tagged.el13
2 files changed, 73 insertions, 13 deletions
diff --git a/gloss-drill.el b/gloss-drill.el
index 6771f4b..08e2198 100644
--- a/gloss-drill.el
+++ b/gloss-drill.el
@@ -7,8 +7,8 @@
;;; Commentary:
;; Spaced-repetition export for `gloss'. Walks the glossary org file
-;; via `org-element' and ensures every term entry carries a `:drill:'
-;; tag and a `:DRILL_CARD_TYPE: twosided' property — `org-drill' then
+;; via `org-map-entries' and ensures every term entry carries a `:drill:'
+;; tag and a `:DRILL_CARD_TYPE: twosided' property. `org-drill' then
;; runs unmodified against the file.
;;
;; Public API:
@@ -16,14 +16,77 @@
;; `gloss-drill-untag-all'
;;
;; Idempotent: running export twice does not double-tag.
-;; Checks `(featurep 'org-drill)' before running; raises a helpful
-;; user-error if `org-drill' isn't installed.
+;; Checks `(featurep \\='org-drill)' before exporting; raises a helpful
+;; user-error if `org-drill' isn't installed. Untag-all does NOT
+;; require `org-drill' — the user might be removing tags after
+;; uninstalling.
;;
;; See `docs/design/gloss.org' for the full design.
;;; Code:
-;; Implementation pending. Track via todo.org.
+(require 'org)
+(require 'gloss-core)
+
+(defconst gloss-drill--card-type "twosided"
+ "Value written to the :DRILL_CARD_TYPE: property by export-all.")
+
+(defconst gloss-drill--tag "drill"
+ "Tag added to every entry by export-all and removed by untag-all.")
+
+(defun gloss-drill--map-entries (fn)
+ "Open `gloss-file', call FN at every top-level entry, and save.
+FN runs with point at the heading line. The buffer is saved only if
+modified."
+ (let ((buf (find-file-noselect gloss-file)))
+ (with-current-buffer buf
+ (unless (verify-visited-file-modtime buf)
+ (revert-buffer t t t))
+ (unless (derived-mode-p 'org-mode)
+ (let ((org-mode-hook nil))
+ (org-mode)))
+ (save-excursion
+ (org-map-entries
+ (lambda ()
+ (when (= 1 (org-current-level))
+ (funcall fn)))))
+ (when (buffer-modified-p)
+ (save-buffer)))))
+
+(defun gloss-drill--add-drill-tag-and-property ()
+ "Add `:drill:' tag and `DRILL_CARD_TYPE' property at the entry at point."
+ (let ((tags (org-get-tags nil t)))
+ (unless (member gloss-drill--tag tags)
+ (org-set-tags (append tags (list gloss-drill--tag)))))
+ (unless (equal (org-entry-get nil "DRILL_CARD_TYPE") gloss-drill--card-type)
+ (org-entry-put nil "DRILL_CARD_TYPE" gloss-drill--card-type)))
+
+(defun gloss-drill--remove-drill-tag-and-property ()
+ "Remove `:drill:' tag and `DRILL_CARD_TYPE' property at the entry at point."
+ (let ((tags (org-get-tags nil t)))
+ (when (member gloss-drill--tag tags)
+ (org-set-tags (delete gloss-drill--tag tags))))
+ (when (org-entry-get nil "DRILL_CARD_TYPE")
+ (org-entry-delete nil "DRILL_CARD_TYPE")))
+
+;;;; Public API
+
+(defun gloss-drill-export-all ()
+ "Tag every entry in `gloss-file' for `org-drill'.
+Adds `:drill:' tag and `DRILL_CARD_TYPE: twosided' property to each
+top-level heading. Idempotent. Signals `user-error' if `org-drill'
+is not installed."
+ (interactive)
+ (unless (featurep 'org-drill)
+ (user-error
+ "gloss-drill: `org-drill' is not installed. Install it with M-x package-install RET org-drill RET"))
+ (gloss-drill--map-entries #'gloss-drill--add-drill-tag-and-property))
+
+(defun gloss-drill-untag-all ()
+ "Remove the `:drill:' tag and `DRILL_CARD_TYPE' property from every entry.
+Does NOT require `org-drill' to be installed."
+ (interactive)
+ (gloss-drill--map-entries #'gloss-drill--remove-drill-tag-and-property))
(provide 'gloss-drill)
;;; gloss-drill.el ends here
diff --git a/tests/test-gloss-drill--export-all-skips-already-tagged.el b/tests/test-gloss-drill--export-all-skips-already-tagged.el
index 52978c6..20fbaea 100644
--- a/tests/test-gloss-drill--export-all-skips-already-tagged.el
+++ b/tests/test-gloss-drill--export-all-skips-already-tagged.el
@@ -21,15 +21,13 @@
Reads the file fresh from disk."
(with-current-buffer (find-file-noselect gloss-file)
(revert-buffer t t t)
- (let ((count 0))
+ (catch 'done
(org-map-entries
(lambda ()
(when (= 1 (org-current-level))
- (setq count (length (cl-remove-if-not
- (lambda (tag) (equal tag "drill"))
- (org-get-tags nil t))))
- (throw 'done nil))))
- count)))
+ (throw 'done
+ (length (seq-filter (lambda (tag) (equal tag "drill"))
+ (org-get-tags nil t))))))))))
(ert-deftest test-gloss-drill-export-all-idempotent-tag-not-duplicated ()
"Boundary: running export-all twice does not duplicate the :drill: tag."
@@ -37,8 +35,7 @@ Reads the file fresh from disk."
(gloss-test--with-org-drill-feature
(gloss-drill-export-all)
(gloss-drill-export-all)
- (catch 'done
- (should (= (gloss-test--drill-tag-count-on-first-entry) 1))))))
+ (should (= (gloss-test--drill-tag-count-on-first-entry) 1)))))
(ert-deftest test-gloss-drill-export-all-idempotent-property-unchanged ()
"Boundary: running export-all twice keeps :DRILL_CARD_TYPE: twosided."