diff options
| author | Craig Jennings <c@cjennings.net> | 2026-04-30 00:30:36 -0500 |
|---|---|---|
| committer | Craig Jennings <c@cjennings.net> | 2026-04-30 00:30:36 -0500 |
| commit | 5b5ac68e138950e2f8d502e22350a62570da88a6 (patch) | |
| tree | 81c27f9ff1d3d3e7443f3fcfc9785d9df7f04c29 | |
| parent | e7938e9193ba1a39aab0e614bb3bf682508685b2 (diff) | |
| download | gloss-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.el | 73 | ||||
| -rw-r--r-- | tests/test-gloss-drill--export-all-skips-already-tagged.el | 13 |
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." |
