>From 612d4daac54e12556333fcd2e07771aa8344c86c Mon Sep 17 00:00:00 2001
From: Jay Kamat <address@hidden>
Date: Sat, 2 Sep 2017 15:57:36 -0400
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'.

This can be disabled by setting `org-provide-todo-statistics' to nil.
---
 etc/ORG-NEWS                     | 22 ++++++++++++++++++++++
 lisp/org-archive.el              |  9 +++++++++
 testing/lisp/test-org-element.el | 33 +++++++++++++++++++++++++++++++++
 3 files changed, 64 insertions(+)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 9f3e62406..316a75f2f 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -8,6 +8,28 @@ See the end of the file for license conditions.
 
 Please send Org bug reports to mailto:address@hidden
 
+* Version 9.2
+
+** Incompatible changes
+** 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.
+
+** Removed functions
+** Removed options
+** New functions
+** Miscellaneous
+
 * Version 9.1
 
 ** Incompatible changes
diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index adb922e75..9ba73a8de 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)
@@ -470,6 +476,9 @@ Archiving time is retained in the ARCHIVE_TIME node property."
 	(outline-hide-subtree)
 	(org-cycle-show-empty-lines 'folded)
 	(goto-char pos)))
+    (when org-provide-todo-statistics
+      ;; Update todo statistics of parent.
+      (org-update-parent-todo-statistics))
     (org-reveal)
     (if (looking-at "^[ \t]*$")
 	(outline-next-visible-heading 1))))
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index 7d1c55f36..e9506d2b0 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -1070,6 +1070,39 @@ Some other text
      (let ((org-archive-tag "Archive"))
        (org-element-property :archivedp (org-element-at-point))))))
 
+(ert-deftest test-org-element/archive-update-status-cookie ()
+  "Test archiving properly updating status cookies."
+  ;; Test org-archive-subtree with two children.
+  (org-test-with-temp-text-in-file "* Top [%]\n** DONE One\n** TODO Two"
+    (forward-line 1)
+    (org-archive-subtree)
+    (forward-line -1)
+    (should (string=
+	      (org-element-property :title (org-element-at-point))
+	      "Top [0%]")))
+  ;; Test org-archive-subtree with one child.
+  (org-test-with-temp-text-in-file "* Top [%]\n** TODO Two"
+    (forward-line 1)
+    (org-archive-subtree)
+    (forward-line -1)
+    (should (string=
+	      (org-element-property :title (org-element-at-point))
+	      "Top [100%]")))
+  ;; Test org-archive-to-archive-sibling with two children.
+  (org-test-with-temp-text "* Top [%]\n<point>** TODO One\n** DONE Two"
+    (org-archive-to-archive-sibling)
+    (forward-line -1)
+    (should (string=
+	      (org-element-property :title (org-element-at-point))
+	      "Top [100%]")))
+  ;; Test org-archive-to-archive-sibling with two children.
+  (org-test-with-temp-text "* Top [%]\n<point>** DONE Two"
+    (org-archive-to-archive-sibling)
+    (forward-line -1)
+    (should (string=
+	      (org-element-property :title (org-element-at-point))
+	      "Top [0%]"))))
+
 (ert-deftest test-org-element/headline-properties ()
   "Test properties from property drawer."
   ;; All properties from property drawer have their symbol upper
-- 
2.11.0