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

@@ -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

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]*$")

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 <jaygkamat@gmail.com>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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<point>** 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<point>** 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<point>** 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<point>** 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