Hello all!

For the FSF40 hackathon we are trying to implement an "unarchive" feature.

The project is documented here:
https://orgmode.org/worg/fsf40-hackathon-org.html

I have created the first patch for this feature, adding tests for stuff that
already exists.  This patch tests that the correct context is added to a
heading when it is archived.  Eventually we will use this context to unarchive
a heading.

Tests pass on emacs 30.2, 29.4, and 28.2.
Tests pass on TZ= UTC, "Europe/Istanbul", and "America/New_York".

>From 3f25850a2b191b95a99e8d2da35b4762623d8431 Mon Sep 17 00:00:00 2001
From: Morgan Smith <[email protected]>
Date: Fri, 21 Nov 2025 13:46:07 -0500
Subject: [PATCH] Testing: test-org-archive/context: New test

* testing/lisp/test-org-archive.el (test-org-archive/context): New test.
---
 testing/lisp/test-org-archive.el | 92 ++++++++++++++++++++++++++++++++
 1 file changed, 92 insertions(+)

diff --git a/testing/lisp/test-org-archive.el b/testing/lisp/test-org-archive.el
index 47be89b6d..5e4ceb9b0 100644
--- a/testing/lisp/test-org-archive.el
+++ b/testing/lisp/test-org-archive.el
@@ -97,6 +97,98 @@ test-org-archive/datetree
 	  (org-archive-subtree)
 	  (buffer-string)))))))
 
+(ert-deftest test-org-archive/context ()
+  "Test that `org-archive-subtree' creates context info.
+Context info is controlled by `org-archive-save-context-info'."
+  (let ((org-archive-location "::* Archived Tasks"))
+    (org-test-at-time "<2020-07-05 Sun>"
+      (org-test-with-temp-text-in-file "* a\n"
+        (should
+         (string-equal
+          (concat
+           "* Archived Tasks
+
+** a
+:PROPERTIES:
+:ARCHIVE_TIME: 2020-07-05 Sun 00:00\n"
+           ":ARCHIVE_FILE: " buffer-file-name "\n"
+           ":ARCHIVE_CATEGORY: " (file-name-nondirectory buffer-file-name) "\n"
+           ":END:")
+          (progn
+            (org-archive-subtree)
+            (string-trim (buffer-string))))))
+      (org-test-with-temp-text-in-file "* a\n** b"
+        (should
+         (string-equal
+          (concat "* Archived Tasks
+
+** a
+:PROPERTIES:
+:ARCHIVE_TIME: 2020-07-05 Sun 00:00\n"
+                  ":ARCHIVE_FILE: " buffer-file-name "\n"
+                  ":ARCHIVE_CATEGORY: " (file-name-nondirectory buffer-file-name) "\n"
+                  ":END:
+*** b")
+          (progn
+            (org-archive-subtree)
+            (string-trim (buffer-string))))))
+      (org-test-with-temp-text-in-file "* a\n<point>** TODO b"
+        (should
+         (string-equal
+          (concat
+           "* a
+* Archived Tasks
+
+** TODO b
+:PROPERTIES:
+:ARCHIVE_TIME: 2020-07-05 Sun 00:00\n"
+           ":ARCHIVE_FILE: " buffer-file-name "\n"
+           ":ARCHIVE_OLPATH: a\n"
+           ":ARCHIVE_CATEGORY: " (file-name-nondirectory buffer-file-name) "\n"
+           ":ARCHIVE_TODO: TODO\n"
+           ":END:")
+          (progn
+            (org-archive-subtree)
+            (string-trim (buffer-string))))))
+      (org-test-with-temp-text-in-file "* a\\q [/] slashes\n<point>** b"
+        (should
+         (string-equal
+          (concat
+           "* a\\q [/] slashes
+* Archived Tasks
+
+** b
+:PROPERTIES:
+:ARCHIVE_TIME: 2020-07-05 Sun 00:00\n"
+           ":ARCHIVE_FILE: " buffer-file-name "\n"
+           ":ARCHIVE_OLPATH: a\\q [/] slashes\n"
+           ":ARCHIVE_CATEGORY: " (file-name-nondirectory buffer-file-name) "\n"
+
+           ":END:")
+          (progn
+            (org-archive-subtree)
+            (string-trim (buffer-string)))))))
+    (let ((org-tags-column -10))
+      (dolist (org-archive-save-context-info '((ltags) (itags) (ltags itags)))
+        (org-test-with-temp-text-in-file "* a  :top:\n<point>** b  :b_tag:\n"
+          (should
+           (string-equal
+            (concat "* a  :top:
+* Archived Tasks
+
+** b :top:b_tag:
+:PROPERTIES:\n"
+                    (if (memq 'ltags org-archive-save-context-info)
+                        ":ARCHIVE_LTAGS: b_tag\n"
+                      "")
+                    (if (memq 'itags org-archive-save-context-info)
+                        ":ARCHIVE_ITAGS: top\n"
+                      "")
+                    ":END:")
+            (progn
+              (org-archive-subtree)
+              (string-trim (buffer-string))))))))))
+
 (ert-deftest test-org-archive/to-archive-sibling ()
   "Test `org-archive-to-archive-sibling' specifications."
   ;; Archive sibling before or after archive heading.

base-commit: def8e57c18b7a875c4a367d4a29d82b27e67ce16
-- 
2.51.2

Reply via email to