diff --git a/doc/org-manual.org b/doc/org-manual.org index aef6675e4..040fccc21 100644 --- a/doc/org-manual.org +++ b/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 diff --git a/lisp/org-archive.el b/lisp/org-archive.el index d3e12d17b..4a0de3cb5 100644 --- a/lisp/org-archive.el +++ b/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)))) diff --git a/testing/lisp/test-org-archive.el b/testing/lisp/test-org-archive.el index 8190ab73c..71ab427d2 100644 --- a/testing/lisp/test-org-archive.el +++ b/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.