Adding the ability to archive into the datetree (updated)

[Andrew Hyatt <ahyatt@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 606 bytes --]

Hi everyone,

I previously sent out a patch to add the ability to archive into the
datetree.  The ability to store finished items by date (along with any
other journal-type entry) seems pretty useful to me, which is why I
wrote this.  Bernt Hansen did a review of my previous patch, and did a
great job in testing it out, catching several issues.  Thanks, Bernt!

I've fixed all the reported issues, and am attaching the modified
patch. I'd love for this to get into the next release.  If anyone has
a desire to try this out, I'd love to hear if it is clear how to use
it, and if you encounter any issues.

[-- Attachment #2: 0001-Add-the-ability-to-archive-to-the-datetree.patch --]
[-- Type: application/octet-stream, Size: 6581 bytes --]

From a8b7e360a66154319e178eed07760e46eabd627e Mon Sep 17 00:00:00 2001
From: Andrew Hyatt <ahyatt@gmail.com>
Date: Sat, 28 Jan 2012 21:41:01 -0500
Subject: [PATCH] Add the ability to archive to the datetree.

---
 doc/org.texi        |   22 +++++++++++++---------
 lisp/org-archive.el |   27 +++++++++++++++++++++------
 lisp/org.el         |   10 ++++++++++
 3 files changed, 44 insertions(+), 15 deletions(-)

diff --git a/doc/org.texi b/doc/org.texi
index 9581cec..11c906f 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -6870,16 +6870,20 @@ is invoked, the level 1 trees will be checked.
 @cindex archive locations
 The default archive location is a file in the same directory as the
 current file, with the name derived by appending @file{_archive} to the
-current file name.  For information and examples on how to change this,
+current file name.  You can also choose what heading to file archived
+items under, with the possibility to add them to a datetree in a file.
+For information and examples on how to specify the file and the heading,
 see the documentation string of the variable
-@code{org-archive-location}.  There is also an in-buffer option for
-setting this variable, for example@footnote{For backward compatibility,
-the following also works: If there are several such lines in a file,
-each specifies the archive location for the text below it.  The first
-such line also applies to any text before its definition.  However,
-using this method is @emph{strongly} deprecated as it is incompatible
-with the outline structure of the document.  The correct method for
-setting multiple archive locations in a buffer is using properties.}:
+@code{org-archive-location}.
+
+There is also an in-buffer option for setting this variable, for
+example@footnote{For backward compatibility, the following also works:
+If there are several such lines in a file, each specifies the archive
+location for the text below it.  The first such line also applies to any
+text before its definition.  However, using this method is
+@emph{strongly} deprecated as it is incompatible with the outline
+structure of the document.  The correct method for setting multiple
+archive locations in a buffer is using properties.}:
 
 @cindex #+ARCHIVE
 @example
diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index e426055..1023c2f 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -213,13 +213,14 @@ this heading."
 		 (current-time)))
 	  category todo priority ltags itags atags
 	  ;; end of variables that will be used for saving context
-	  location afile heading buffer level newfile-p infile-p visiting)
+	  location afile heading buffer level newfile-p infile-p visiting
+	  datetree-date datetree-subheading-p)
 
       ;; Find the local archive location
       (setq location (org-get-local-archive-location)
 	    afile (org-extract-archive-file location)
 	    heading (org-extract-archive-heading location)
-	    infile-p (equal file (abbreviate-file-name afile)))
+	    infile-p (equal file (abbreviate-file-name (or afile ""))))
       (unless afile
 	(error "Invalid `org-archive-location'"))
 
@@ -230,6 +231,13 @@ this heading."
 	(setq buffer (current-buffer)))
       (unless buffer
 	(error "Cannot access file \"%s\"" afile))
+      (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))
+	(setq datetree-date (org-date-to-gregorian
+			     (or (org-entry-get nil "CLOSED" t) time))))
       (if (and (> (length heading) 0)
 	       (string-match "^\\*+" heading))
 	  (setq level (match-end 0))
@@ -262,6 +270,10 @@ this heading."
 	  (goto-char (point-max))
 	  (insert (format "\nArchived entries from file %s\n\n"
 			  (buffer-file-name this-buffer))))
+	(when datetree-date
+	  (require 'org-datetree)
+	  (org-datetree-find-date-create datetree-date)
+	  (org-narrow-to-subtree))
 	;; Force the TODO keywords of the original buffer
 	(let ((org-todo-line-regexp tr-org-todo-line-regexp)
 	      (org-todo-keywords-1 tr-org-todo-keywords-1)
@@ -275,7 +287,7 @@ this heading."
 		 tr-org-odd-levels-only)))
 	  (goto-char (point-min))
 	  (show-all)
-	  (if heading
+	  (if (and heading (not (and datetree-date (not datetree-subheading-p))))
 	      (progn
 		(if (re-search-forward
 		     (concat "^" (regexp-quote heading)
@@ -285,7 +297,8 @@ this heading."
 		  ;; Heading not found, just insert it at the end
 		  (goto-char (point-max))
 		  (or (bolp) (insert "\n"))
-		  (insert "\n" heading "\n")
+		  ;; datetrees don't need too much spacing
+		  (insert (if datetree-date "" "\n") heading "\n")
 		  (end-of-line 0))
 		;; Make the subtree visible
 		(show-subtree)
@@ -296,9 +309,10 @@ this heading."
 		  (org-end-of-subtree t))
 		(skip-chars-backward " \t\r\n")
 		(and (looking-at "[ \t\r\n]*")
-		     (replace-match "\n\n")))
+		     ;; datetree archives don't need so much spacing.
+		     (replace-match (if datetree-date "\n" "\n\n"))))
 	    ;; No specific heading, just go to end of file.
-	    (goto-char (point-max)) (insert "\n"))
+	    (goto-char (point-max)) (unless datetree-date (insert "\n")))
 	  ;; Paste
 	  (org-paste-subtree (org-get-valid-level level (and heading 1)))
 	  ;; Shall we append inherited tags?
@@ -326,6 +340,7 @@ this heading."
 		  (setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
 		  (org-entry-put (point) n v)))))
 
+	  (widen)
 	  ;; Save and kill the buffer, if it is not the same buffer.
 	  (when (not (eq this-buffer buffer))
 	    (save-buffer))))
diff --git a/lisp/org.el b/lisp/org.el
index 5d52884..1ff6509 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4138,6 +4138,16 @@ Here are a few examples:
 	Archive in file ./basement (relative path), as level 3 trees
 	below the level 2 heading \"** Finished Tasks\".
 
+\"~/org/datetree.org::datetree/* Finished Tasks\"
+        The \"datetree/\" string is special, signifying to
+        archive items to the datetree.  Items are placed in
+        either the CLOSED date of the item, or the current date
+        if there is no CLOSED date.  The heading will be a
+        subentry to the current date.  There doesn't need to be a
+        heading, but there always needs to be a slash after
+        datetree.  For example, to store archived items directly
+        in the datetree, use \"~/org/datetree.org::datetree/\".
+
 You may set this option on a per-file basis by adding to the buffer a
 line like
 
-- 
1.7.1