Update to Org 9.4.1

1 files changed, 43 insertions, 11 deletions

diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el
index b33025be0f8..4a0de3cb5a6 100644
--- a/lisp/org/org-archive.el
+++ b/lisp/org/org-archive.el
@@ -24,7 +24,7 @@
 ;;
 ;;; Commentary:
 
-;; This file contains the face definitions for Org.
+;; This file contains the archive functionality for Org.
 
 ;;; Code:
 
@@ -91,6 +91,25 @@ When a string, a %s formatter will be replaced by the file name."
 	  (const :tag "When archiving a subtree to the same file" infile)
 	  (const :tag "Always" t)))
 
+(defcustom org-archive-subtree-save-file-p 'from-org
+  "Conditionally save the archive file after archiving a subtree.
+This variable can be any of the following symbols:
+
+t              saves in all cases.
+`from-org'     prevents saving from an agenda-view.
+`from-agenda'  saves only when the archive is initiated from an agenda-view.
+nil            prevents saving in all cases.
+
+Note that, regardless of this value, the archive buffer is never
+saved when archiving into a location in the current buffer."
+  :group 'org-archive
+  :package-version '(Org . "9.4")
+  :type '(choice
+	  (const :tag "Save archive buffer" t)
+	  (const :tag "Save when archiving from agenda" from-agenda)
+	  (const :tag "Save when archiving from an Org buffer" from-org)
+	  (const :tag "Do not save")))
+
 (defcustom org-archive-save-context-info '(time file olpath category todo itags)
   "Parts of context info that should be stored as properties when archiving.
 When a subtree is moved to an archive file, it loses information given by
@@ -230,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)
@@ -290,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))))
@@ -361,6 +384,15 @@ direct children of this heading."
 		     (point)
 		     (concat "ARCHIVE_" (upcase (symbol-name item)))
 		     value))))
+	      ;; Save the buffer, if it is not the same buffer and
+	      ;; depending on `org-archive-subtree-save-file-p'.
+	      (unless (eq this-buffer buffer)
+		(when (or (eq org-archive-subtree-save-file-p t)
+			  (eq org-archive-subtree-save-file-p
+			      (if (boundp 'org-archive-from-agenda)
+				  'from-agenda
+				'from-org)))
+		  (save-buffer)))
 	      (widen))))
 	;; Here we are back in the original buffer.  Everything seems
 	;; to have worked.  So now run hooks, cut the tree and finish