emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATCH] Add the ability to archive to the datetree.
@ 2011-11-09  5:06 Andrew Hyatt
  2011-11-09 11:22 ` Bernt Hansen
  0 siblings, 1 reply; 4+ messages in thread
From: Andrew Hyatt @ 2011-11-09  5:06 UTC (permalink / raw)
  To: emacs-orgmode

* org.el (org-archive-location): Add documentation on new datetree
option.
* org-archive.el (org-archive-subtree): Add special handling
of datetree options to archive to datetree.

---
 lisp/org-archive.el |   21 +++++++++++++++++----
 lisp/org.el         |    7 +++++++
 2 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index 16c35cf..4df6f1e 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)

       ;; 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,12 @@ 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 (string-replace-match "\\`datetree/" heading "***"))
+	(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 +269,9 @@ this heading."
 	  (goto-char (point-max))
 	  (insert (format "\nArchived entries from file %s\n\n"
 			  (buffer-file-name this-buffer))))
+	(when datetree-date
+	  (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)
@@ -285,7 +295,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 to much spacing
+		  (if datetree-date (insert heading) (insert "\n" heading "\n"))
 		  (end-of-line 0))
 		;; Make the subtree visible
 		(show-subtree)
@@ -296,7 +307,8 @@ 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"))
 	  ;; Paste
@@ -326,6 +338,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 6ee3b4e..9c80c9c 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4046,6 +4046,13 @@ 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, signifiying 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.
+
 You may set this option on a per-file basis by adding to the buffer a
 line like

-- 
1.7.3.1

^ permalink raw reply related	[flat|nested] 4+ messages in thread

* Re: [PATCH] Add the ability to archive to the datetree.
  2011-11-09  5:06 [PATCH] Add the ability to archive to the datetree Andrew Hyatt
@ 2011-11-09 11:22 ` Bernt Hansen
  2011-11-09 15:24   ` Andrew Hyatt
  0 siblings, 1 reply; 4+ messages in thread
From: Bernt Hansen @ 2011-11-09 11:22 UTC (permalink / raw)
  To: Andrew Hyatt; +Cc: emacs-orgmode

Hi Andrew,

I'm just eyeballing your patch and there's a typo in your last hunk -
see comment inline.

Don't you also need to update the texinfo documentation for this
enhancement?

-Bernt

Andrew Hyatt <ahyatt@gmail.com> writes:

> * org.el (org-archive-location): Add documentation on new datetree
> option.
> * org-archive.el (org-archive-subtree): Add special handling
> of datetree options to archive to datetree.
>
> ---
>  lisp/org-archive.el |   21 +++++++++++++++++----
>  lisp/org.el         |    7 +++++++
>  2 files changed, 24 insertions(+), 4 deletions(-)
>
> diff --git a/lisp/org-archive.el b/lisp/org-archive.el
> index 16c35cf..4df6f1e 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)
>
>        ;; 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,12 @@ 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 (string-replace-match "\\`datetree/" heading "***"))
> +	(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 +269,9 @@ this heading."
>  	  (goto-char (point-max))
>  	  (insert (format "\nArchived entries from file %s\n\n"
>  			  (buffer-file-name this-buffer))))
> +	(when datetree-date
> +	  (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)
> @@ -285,7 +295,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 to much spacing
> +		  (if datetree-date (insert heading) (insert "\n" heading "\n"))
>  		  (end-of-line 0))
>  		;; Make the subtree visible
>  		(show-subtree)
> @@ -296,7 +307,8 @@ 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"))
>  	  ;; Paste
> @@ -326,6 +338,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 6ee3b4e..9c80c9c 100644
> --- a/lisp/org.el
> +++ b/lisp/org.el
> @@ -4046,6 +4046,13 @@ 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, signifiying to
                                                ^^^^^^^^^^^
Typo here                                       signifying

> +        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.
> +
>  You may set this option on a per-file basis by adding to the buffer a
>  line like

^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: [PATCH] Add the ability to archive to the datetree.
  2011-11-09 11:22 ` Bernt Hansen
@ 2011-11-09 15:24   ` Andrew Hyatt
  0 siblings, 0 replies; 4+ messages in thread
From: Andrew Hyatt @ 2011-11-09 15:24 UTC (permalink / raw)
  To: Bernt Hansen; +Cc: emacs-orgmode

The documentation didn't go into any details about how to specify the
org-archive-location, or what you could do with it,  instead it just
referred to the documentation of that variable.  Still, now that you
mention it, it seemed worthwhile to add  something to the docs, so I
did that.  I'll send another version of the patch now.

On Wed, Nov 9, 2011 at 6:22 AM, Bernt Hansen <bernt@norang.ca> wrote:
> Hi Andrew,
>
> I'm just eyeballing your patch and there's a typo in your last hunk -
> see comment inline.
>
> Don't you also need to update the texinfo documentation for this
> enhancement?
>
> -Bernt
>
> Andrew Hyatt <ahyatt@gmail.com> writes:
>
>> * org.el (org-archive-location): Add documentation on new datetree
>> option.
>> * org-archive.el (org-archive-subtree): Add special handling
>> of datetree options to archive to datetree.
>>
>> ---
>>  lisp/org-archive.el |   21 +++++++++++++++++----
>>  lisp/org.el         |    7 +++++++
>>  2 files changed, 24 insertions(+), 4 deletions(-)
>>
>> diff --git a/lisp/org-archive.el b/lisp/org-archive.el
>> index 16c35cf..4df6f1e 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)
>>
>>        ;; 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,12 @@ 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 (string-replace-match "\\`datetree/" heading "***"))
>> +     (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 +269,9 @@ this heading."
>>         (goto-char (point-max))
>>         (insert (format "\nArchived entries from file %s\n\n"
>>                         (buffer-file-name this-buffer))))
>> +     (when datetree-date
>> +       (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)
>> @@ -285,7 +295,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 to much spacing
>> +               (if datetree-date (insert heading) (insert "\n" heading "\n"))
>>                 (end-of-line 0))
>>               ;; Make the subtree visible
>>               (show-subtree)
>> @@ -296,7 +307,8 @@ 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"))
>>         ;; Paste
>> @@ -326,6 +338,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 6ee3b4e..9c80c9c 100644
>> --- a/lisp/org.el
>> +++ b/lisp/org.el
>> @@ -4046,6 +4046,13 @@ 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, signifiying to
>                                                ^^^^^^^^^^^
> Typo here                                       signifying
>
>> +        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.
>> +
>>  You may set this option on a per-file basis by adding to the buffer a
>>  line like
>

^ permalink raw reply	[flat|nested] 4+ messages in thread

* [PATCH] Add the ability to archive to the datetree.
@ 2011-11-09 15:26 Andrew Hyatt
  0 siblings, 0 replies; 4+ messages in thread
From: Andrew Hyatt @ 2011-11-09 15:26 UTC (permalink / raw)
  To: emacs-orgmode

* org.el (org-archive-location): Add documentation on new datetree
option.
* org-archive.el (org-archive-subtree): Add special handling
of datetree options to archive to datetree.

---
 doc/org.texi        |   22 +++++++++++++---------
 lisp/org-archive.el |   21 +++++++++++++++++----
 lisp/org.el         |    7 +++++++
 3 files changed, 37 insertions(+), 13 deletions(-)

diff --git a/doc/org.texi b/doc/org.texi
index 143b184..128f966 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -6854,16 +6854,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 16c35cf..35ef290 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)

       ;; 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,12 @@ 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 (string-replace-match "\\`datetree/" heading "***"))
+	(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 +269,9 @@ this heading."
 	  (goto-char (point-max))
 	  (insert (format "\nArchived entries from file %s\n\n"
 			  (buffer-file-name this-buffer))))
+	(when datetree-date
+	  (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)
@@ -285,7 +295,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
+		  (if datetree-date (insert heading) (insert "\n" heading "\n"))
 		  (end-of-line 0))
 		;; Make the subtree visible
 		(show-subtree)
@@ -296,7 +307,8 @@ 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"))
 	  ;; Paste
@@ -326,6 +338,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 6ee3b4e..e19894a 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4046,6 +4046,13 @@ 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.
+
 You may set this option on a per-file basis by adding to the buffer a
 line like

-- 
1.7.3.1

^ permalink raw reply related	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2011-11-09 15:26 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2011-11-09  5:06 [PATCH] Add the ability to archive to the datetree Andrew Hyatt
2011-11-09 11:22 ` Bernt Hansen
2011-11-09 15:24   ` Andrew Hyatt
  -- strict thread matches above, loose matches on Subject: below --
2011-11-09 15:26 Andrew Hyatt

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).