Merge branch 'maint'

doc/org-manual.org

@@ -9886,6 +9886,13 @@ the other commands, point needs to be in the desired line.
   #+findex: org-agenda-priority-down
   Decrease the priority of the current item.
 
+- {{{kbd(C-c C-x e)}}} or short {{{kbd(e)}}} (~org-agenda-set-effort~) ::
+
+  #+kindex: e
+  #+kindex: C-c C-x e
+  #+findex: org-agenda-set-effort
+  Set the effort property for the current item.
+
 - {{{kbd(C-c C-z)}}} or short {{{kbd(z)}}} (~org-agenda-add-note~) ::
 
   #+kindex: z

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.