archive: Account for org-odd-levels-only in datetree calculations

* lisp/org-archive.el (org-archive-subtree): Honor org-odd-levels-only
when filling in org-archive-location placeholders with stars.
* testing/lisp/test-org-archive.el (test-org-archive/datetree): Add test.

Reported-by: Charles Tam <me@charlest.net>
Ref: https://orgmode.org/list/CAKu+9YVus=wPKGMY_vWp_7ND+oK7ZrRhN=1TXa2Cok3=8se1gg@mail.gmail.com

lisp/org-archive.el

@@ -249,12 +249,20 @@ direct children of this heading."
 			   ((find-buffer-visiting afile))
 			   ((find-file-noselect afile))
 			   (t (error "Cannot access file \"%s\"" afile))))
+	     (org-odd-levels-only
+	      (if (local-variable-p 'org-odd-levels-only (current-buffer))
+		  org-odd-levels-only
+		tr-org-odd-levels-only))
 	     level datetree-date datetree-subheading-p)
-	(when (string-match "\\`datetree/" heading)
-	  ;; Replace with ***, to represent the 3 levels of headings the
-	  ;; datetree has.
-	  (setq heading (replace-regexp-in-string "\\`datetree/" "***" heading))
-	  (setq datetree-subheading-p (> (length heading) 3))
+	(when (string-match "\\`datetree/\\(\\**\\)" heading)
+	  ;; "datetree/" corresponds to 3 levels of headings.
+	  (let ((nsub (length (match-string 1 heading))))
+	    (setq heading (concat (make-string
+				   (+ (if org-odd-levels-only 5 3)
+				      (* (org-level-increment) nsub))
+				   ?*)
+				  (substring heading (match-end 0))))
+	    (setq datetree-subheading-p (> nsub 0)))
 	  (setq datetree-date (org-date-to-gregorian
 			       (or (org-entry-get nil "CLOSED" t) time))))
 	(if (and (> (length heading) 0)
@@ -309,11 +317,7 @@ direct children of this heading."
 		  (org-todo-kwd-alist tr-org-todo-kwd-alist)
 		  (org-done-keywords tr-org-done-keywords)
 		  (org-todo-regexp tr-org-todo-regexp)
-		  (org-todo-line-regexp tr-org-todo-line-regexp)
-		  (org-odd-levels-only
-		   (if (local-variable-p 'org-odd-levels-only (current-buffer))
-		       org-odd-levels-only
-		     tr-org-odd-levels-only)))
+		  (org-todo-line-regexp tr-org-todo-line-regexp))
 	      (goto-char (point-min))
 	      (org-show-all '(headings blocks))
 	      (if (and heading (not (and datetree-date (not datetree-subheading-p))))

testing/lisp/test-org-archive.el

@@ -57,6 +57,44 @@
       (forward-line -1)
       (org-element-property :title (org-element-at-point))))))
 
+(ert-deftest test-org-archive/datetree ()
+  "Test `org-archive-subtree' with a datetree target."
+  (org-test-at-time "<2020-07-05 Sun>"
+    ;; Test in buffer target with no additional subheadings...
+    (should
+     (string-match-p
+      (regexp-quote "*** 2020-07-05 Sunday\n**** a")
+      (org-test-with-temp-text-in-file "* a\n"
+	(let ((org-archive-location "::datetree/"))
+	  (org-archive-subtree)
+	  (buffer-string)))))
+    ;; ... and with `org-odd-levels-only' non-nil.
+    (should
+     (string-match-p
+      (regexp-quote "***** 2020-07-05 Sunday\n******* a")
+      (org-test-with-temp-text-in-file "* a\n"
+	(let ((org-archive-location "::datetree/")
+	      (org-odd-levels-only t))
+	  (org-archive-subtree)
+	  (buffer-string)))))
+    ;; Test in buffer target with an additional subheading...
+    (should
+     (string-match-p
+      (regexp-quote "*** 2020-07-05 Sunday\n**** a\n***** b")
+      (org-test-with-temp-text-in-file "* b\n"
+	(let ((org-archive-location "::datetree/* a"))
+	  (org-archive-subtree)
+	  (buffer-string)))))
+    ;; ... and with `org-odd-levels-only' non-nil.
+    (should
+     (string-match-p
+      (regexp-quote "***** 2020-07-05 Sunday\n******* a\n********* b")
+      (org-test-with-temp-text-in-file "* b\n"
+	(let ((org-archive-location "::datetree/* a")
+	      (org-odd-levels-only t))
+	  (org-archive-subtree)
+	  (buffer-string)))))))
+
 (ert-deftest test-org-archive/to-archive-sibling ()
   "Test `org-archive-to-archive-sibling' specifications."
   ;; Archive sibling before or after archive heading.