From 331ba684956faa9732365db209ac6c6822735932 Mon Sep 17 00:00:00 2001 From: Jay Kamat Date: Wed, 6 Sep 2017 14:31:01 +0200 Subject: [PATCH] org-archive.el: Update statistic cookies when archiving * lisp/org-archive.el (org-archive-subtree): Update todo statistics when calling `org-archive-subtree'. (org-archive-to-archive-sibling): Update cookie statistics when calling `org-archive-to-archive-sibling'. * testing/lisp/test-org-archive.el: New file. This can be disabled by setting `org-provide-todo-statistics' to nil. --- etc/ORG-NEWS | 15 +++++++- lisp/org-archive.el | 11 +++++- testing/lisp/test-org-archive.el | 61 ++++++++++++++++++++++++++++++++ 3 files changed, 85 insertions(+), 2 deletions(-) create mode 100644 testing/lisp/test-org-archive.el diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 22b2a0ab8..cce6f4e36 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -10,9 +10,22 @@ Please send Org bug reports to mailto:emacs-orgmode@gnu.org. * Version 9.2 ** New features +*** ~org-archive~ functions update status cookies + +Archiving headers through ~org-archive-subtree~ and +~org-archive-to-archive-sibling~ such as the ones listed below: + +#+BEGIN_SRC org + ,* Top [1/2] + ,** DONE Completed + ,** TODO Working +#+END_SRC + +Will update the status cookie in the top level header. + *** Disable =org-agenda-overriding-header= by setting to empty string -The =org-agenda-overriding-header= inserted into agenda views can now +The ~org-agenda-overriding-header~ inserted into agenda views can now be disabled by setting it to an empty string. * Version 9.1 diff --git a/lisp/org-archive.el b/lisp/org-archive.el index adb922e75..a64e1e026 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -393,6 +393,12 @@ direct children of this heading." (when (featurep 'org-inlinetask) (org-inlinetask-remove-END-maybe)) (setq org-markers-to-move nil) + (when org-provide-todo-statistics + (save-excursion + ;; Go to parent, even if no children exist. + (org-up-heading-safe) + ;; Update cookie of parent. + (org-update-statistics-cookies nil))) (message "Subtree archived %s" (if (eq this-buffer buffer) (concat "under heading: " heading) @@ -419,7 +425,7 @@ Archiving time is retained in the ARCHIVE_TIME node property." '(progn (setq org-map-continue-from (progn (org-back-to-heading) (if (looking-at (concat "^.*:" org-archive-tag ":.*$")) - (org-end-of-subtree t) + (org-end-of-subtree t) (point)))) (when (org-at-heading-p) (org-archive-to-archive-sibling))) @@ -469,6 +475,9 @@ Archiving time is retained in the ARCHIVE_TIME node property." (outline-up-heading 1 t) (outline-hide-subtree) (org-cycle-show-empty-lines 'folded) + (when org-provide-todo-statistics + ;; Update TODO statistics of parent. + (org-update-parent-todo-statistics)) (goto-char pos))) (org-reveal) (if (looking-at "^[ \t]*$") diff --git a/testing/lisp/test-org-archive.el b/testing/lisp/test-org-archive.el new file mode 100644 index 000000000..7bde933ba --- /dev/null +++ b/testing/lisp/test-org-archive.el @@ -0,0 +1,61 @@ +;;; test-org-archive.el --- Test for Org Archive -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Jay Kamat + +;; Author: Jay Kamat + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + + +(ert-deftest test-org-element/archive-update-status-cookie () + "Test archiving properly updating status cookies." + ;; Test org-archive-subtree with two children. + (should + (equal + "Top [0%]" + (org-test-with-temp-text-in-file + "* Top [%]\n** DONE One\n** TODO Two" + (org-archive-subtree) + (forward-line -1) + (org-element-property :title (org-element-at-point))))) + ;; Test org-archive-subtree with one child. + (should + (equal + "Top [100%]" + (org-test-with-temp-text-in-file "* Top [%]\n** TODO Two" + (org-archive-subtree) + (forward-line -1) + (org-element-property :title (org-element-at-point))))) + ;; Test org-archive-to-archive-sibling with two children. + (should + (equal + "Top [100%]" + (org-test-with-temp-text "* Top [%]\n** TODO One\n** DONE Two" + (org-archive-to-archive-sibling) + (forward-line -1) + (org-element-property :title (org-element-at-point))))) + ;; Test org-archive-to-archive-sibling with two children. + (should + (equal + "Top [0%]" + (org-test-with-temp-text "* Top [%]\n** DONE Two" + (org-archive-to-archive-sibling) + (forward-line -1) + (org-element-property :title (org-element-at-point)))))) + + +(provide 'test-org-archive) +;;; test-org-archive.el ends here