[PATCH RFC] subtree archive hook?

[PATCH RFC] subtree archive hook?

[Eric Abrahamsen]

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

I think it would be useful to have a hook that runs before archiving a
subtree. I'm attaching two patches: one that includes a hook in the
archive process, and another (by way of an example) that adds a function
to that hook for the org-attach library. You can set the option
`org-attach-archive-delete' to a non-nil value to have org-attach delete
a subtree's attachments when you archive it.

Let me know what you think!

Eric


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-Provide-a-hook-during-the-archive-process.patch --]
[-- Type: text/x-diff, Size: 1681 bytes --]

From 1bfc84570f29dd884c2759dfe19116f09228ed4e Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Sun, 12 Oct 2014 22:01:29 +0800
Subject: [PATCH 2/3] Provide a hook during the archive process

* lisp/org-archive.el (org-archive-hook): New hook.
  (org-archive-subtree): Run hook.
---
 lisp/org-archive.el | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index 700e59b..c7f02b9 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -119,6 +119,13 @@ information."
 	      (const :tag "Outline path" olpath)
 	      (const :tag "Local tags" ltags)))
 
+(defvar org-archive-hook nil
+  "Hook run after successfully archiving a subtree.
+
+Hook functions are called with point on the subtree in the
+original file. At this stage, the subtree has been added to the
+archive location, but not yet deleted from the original file.")
+
 (defun org-get-local-archive-location ()
   "Get the archive location applicable at point."
   (let ((re "^[ \t]*#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
@@ -366,8 +373,10 @@ this heading."
 	    ;; Save and kill the buffer, if it is not the same buffer.
 	    (when (not (eq this-buffer buffer))
 	      (save-buffer))))
-	;; Here we are back in the original buffer.  Everything seems to have
-	;; worked.  So now cut the tree and finish up.
+	;; Here we are back in the original buffer.  Everything seems
+	;; to have worked.  So now run hooks, cut the tree and finish
+	;; up.
+	(run-hooks 'org-archive-hook)
 	(let (this-command) (org-cut-subtree))
 	(when (featurep 'org-inlinetask)
 	  (org-inlinetask-remove-END-maybe))
-- 
2.1.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0003-Maybe-delete-heading-attachments-when-archiving.patch --]
[-- Type: text/x-diff, Size: 2213 bytes --]

From f6b9bc0e2cef23b87ec77ddb9003c0791f992a2f Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Sun, 12 Oct 2014 22:02:38 +0800
Subject: [PATCH 3/3] Maybe delete heading attachments when archiving

* lisp/org-attach.el (org-attach-archive-delete): New option
  controlling what to do with attachments when archiving.
  (org-attach-archive-delete-maybe): New function that runs as a hook
  on org-attach-hook. Checks the value of org-attach-archive-delete,
  and behaves accordingly.
---
 lisp/org-attach.el | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index 5c341a5..cc077c4 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -120,6 +120,18 @@ lns   create a symbol link.  Note that this is not supported
 	  (const :tag "Link to origin location" t)
 	  (const :tag "Link to the attach-dir location" attached)))
 
+(defcustom org-attach-archive-delete nil
+  "If a subtree is archived, should its attachments be deleted?
+
+Set to nil to never delete attachments, t to always delete
+attachments, and the symbol query to ask."
+  :group 'org-attach
+  :version "24.1"
+  :type '(choice
+	  (const :tag "Never delete attachments" nil)
+	  (const :tag "Always delete attachments" t)
+	  (const :tag "Query the user" query)))
+
 ;;;###autoload
 (defun org-attach ()
   "The dispatcher for attachment commands.
@@ -475,6 +487,26 @@ Basically, this adds the path to the attachment directory, and a \"file:\"
 prefix."
   (concat "file:" (org-attach-expand file)))
 
+(defun org-attach-archive-delete-maybe ()
+  "Maybe delete subtree attachments when archiving.
+
+This function is called by `org-archive-hook'. The option
+`org-attach-archive-delete' controls its behavior."
+  (let (delete-p)
+    (setq delete-p
+	  (cond
+	   ((eq org-attach-archive-delete 'query)
+	    (y-or-n-p "Delete all attachments?"))
+	   ((null org-attach-archive-delete)
+	    nil)
+	   (org-attach-archive-delete
+	    t)
+	   (t nil)))
+    (when delete-p
+      (org-attach-delete-all t))))
+
+(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe)
+
 (provide 'org-attach)
 
 ;; Local variables:
-- 
2.1.2

Re: [PATCH RFC] subtree archive hook?

[Aaron Ecay]

Hi Eric,

Looks like a sensible feature.  One comment:

2014ko urriak 12an, Eric Abrahamsen-ek idatzi zuen:
> 
> I think it would be useful to have a hook that runs before archiving a
> subtree. I'm attaching two patches: one that includes a hook in the
> archive process, and another (by way of an example) that adds a function
> to that hook for the org-attach library. You can set the option
> `org-attach-archive-delete' to a non-nil value to have org-attach delete
> a subtree's attachments when you archive it.
> 
> Let me know what you think!
> 
> Eric
> 
> From 1bfc84570f29dd884c2759dfe19116f09228ed4e Mon Sep 17 00:00:00 2001
> From: Eric Abrahamsen <eric@ericabrahamsen.net>
> Date: Sun, 12 Oct 2014 22:01:29 +0800
> Subject: [PATCH 2/3] Provide a hook during the archive process
> 
> * lisp/org-archive.el (org-archive-hook): New hook.
>   (org-archive-subtree): Run hook.
> ---
>  lisp/org-archive.el | 13 +++++++++++--
>  1 file changed, 11 insertions(+), 2 deletions(-)
> 
> diff --git a/lisp/org-archive.el b/lisp/org-archive.el
> index 700e59b..c7f02b9 100644
> --- a/lisp/org-archive.el
> +++ b/lisp/org-archive.el
> @@ -119,6 +119,13 @@ information."
>  	      (const :tag "Outline path" olpath)
>  	      (const :tag "Local tags" ltags)))
>  
> +(defvar org-archive-hook nil
> +  "Hook run after successfully archiving a subtree.
> +
> +Hook functions are called with point on the subtree in the
> +original file. At this stage, the subtree has been added to the
> +archive location, but not yet deleted from the original file.")
> +
>  (defun org-get-local-archive-location ()
>    "Get the archive location applicable at point."
>    (let ((re "^[ \t]*#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
> @@ -366,8 +373,10 @@ this heading."
>  	    ;; Save and kill the buffer, if it is not the same buffer.
>  	    (when (not (eq this-buffer buffer))
>  	      (save-buffer))))
> -	;; Here we are back in the original buffer.  Everything seems to have
> -	;; worked.  So now cut the tree and finish up.
> +	;; Here we are back in the original buffer.  Everything seems
> +	;; to have worked.  So now run hooks, cut the tree and finish
> +	;; up.
> +	(run-hooks 'org-archive-hook)
>  	(let (this-command) (org-cut-subtree))
>  	(when (featurep 'org-inlinetask)
>  	  (org-inlinetask-remove-END-maybe))

Can the above inlinetask thing also be moved into the hook?  That
seems cleaner, and gives another demonstration of the usefulness of
the feature.

-- 
Aaron Ecay

Re: [PATCH RFC] subtree archive hook?

[Eric Abrahamsen]

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

Aaron Ecay <aaronecay@gmail.com> writes:

> Hi Eric,
>
> Looks like a sensible feature.  One comment:
>
> 2014ko urriak 12an, Eric Abrahamsen-ek idatzi zuen:
>> 
>> I think it would be useful to have a hook that runs before archiving a
>> subtree. I'm attaching two patches: one that includes a hook in the
>> archive process, and another (by way of an example) that adds a function
>> to that hook for the org-attach library. You can set the option
>> `org-attach-archive-delete' to a non-nil value to have org-attach delete
>> a subtree's attachments when you archive it.
>> 
>> Let me know what you think!
>> 
>> Eric
>> 
>> From 1bfc84570f29dd884c2759dfe19116f09228ed4e Mon Sep 17 00:00:00 2001
>> From: Eric Abrahamsen <eric@ericabrahamsen.net>
>> Date: Sun, 12 Oct 2014 22:01:29 +0800
>> Subject: [PATCH 2/3] Provide a hook during the archive process
>> 
>> * lisp/org-archive.el (org-archive-hook): New hook.
>>   (org-archive-subtree): Run hook.
>> ---
>>  lisp/org-archive.el | 13 +++++++++++--
>>  1 file changed, 11 insertions(+), 2 deletions(-)
>> 
>> diff --git a/lisp/org-archive.el b/lisp/org-archive.el
>> index 700e59b..c7f02b9 100644
>> --- a/lisp/org-archive.el
>> +++ b/lisp/org-archive.el
>> @@ -119,6 +119,13 @@ information."
>>  	      (const :tag "Outline path" olpath)
>>  	      (const :tag "Local tags" ltags)))
>>  
>> +(defvar org-archive-hook nil
>> +  "Hook run after successfully archiving a subtree.
>> +
>> +Hook functions are called with point on the subtree in the
>> +original file. At this stage, the subtree has been added to the
>> +archive location, but not yet deleted from the original file.")
>> +
>>  (defun org-get-local-archive-location ()
>>    "Get the archive location applicable at point."
>>    (let ((re "^[ \t]*#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
>> @@ -366,8 +373,10 @@ this heading."
>>  	    ;; Save and kill the buffer, if it is not the same buffer.
>>  	    (when (not (eq this-buffer buffer))
>>  	      (save-buffer))))
>> -	;; Here we are back in the original buffer.  Everything seems to have
>> -	;; worked.  So now cut the tree and finish up.
>> +	;; Here we are back in the original buffer.  Everything seems
>> +	;; to have worked.  So now run hooks, cut the tree and finish
>> +	;; up.
>> +	(run-hooks 'org-archive-hook)
>>  	(let (this-command) (org-cut-subtree))
>>  	(when (featurep 'org-inlinetask)
>>  	  (org-inlinetask-remove-END-maybe))
>
> Can the above inlinetask thing also be moved into the hook?  That
> seems cleaner, and gives another demonstration of the usefulness of
> the feature.

Here's a patch that does it, though I'm a little more cautious about
this since I only did a minimal test.

Two things that worry me: 1) why is it called "remove-END-maybe" when it
appears to remove the whole inlinetask, and 2) it its original habitat
in org-attach, it came after the call to org-cut-subtree, meaning that
it couldn't have operated on the subtree to be archived at all! Or am I
misunderstanding something? I tried it on a test subtree, and the
org-cut-subtree took out the included inlinetask as well.

Anyway, it's a little mysterious, and I'm less confident about this bit.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0004-Move-deletion-of-inlinetasks-to-archive-hook.patch --]
[-- Type: text/x-diff, Size: 1381 bytes --]

From 3236ba94c92c021311f7ffb128686f9c2751d4e1 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Sun, 12 Oct 2014 23:48:49 +0800
Subject: [PATCH 4/4] Move deletion of inlinetasks to archive hook

* lisp/org-archive.el (org-archive-subtree): Remove org-inlinetask
  specific code.

* lisp/org-inlinetask.el: Add org-inlinetask-remove-END-maybe to the
  org-archive-hook.
---
 lisp/org-archive.el    | 2 --
 lisp/org-inlinetask.el | 2 ++
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index c7f02b9..6d07f5a 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -378,8 +378,6 @@ this heading."
 	;; up.
 	(run-hooks 'org-archive-hook)
 	(let (this-command) (org-cut-subtree))
-	(when (featurep 'org-inlinetask)
-	  (org-inlinetask-remove-END-maybe))
 	(setq org-markers-to-move nil)
 	(message "Subtree archived %s"
 		 (if (eq this-buffer buffer)
diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el
index 9e0aadb..206ddf3 100644
--- a/lisp/org-inlinetask.el
+++ b/lisp/org-inlinetask.el
@@ -325,6 +325,8 @@ If the task has an end part, also demote it."
 			    org-inlinetask-min-level))
     (replace-match "")))
 
+(add-hook 'org-archive-hook 'org-inlinetask-remove-END-maybe)
+
 (eval-after-load "org"
   '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify))
 
-- 
2.1.2

Re: [PATCH RFC] subtree archive hook?

[Aaron Ecay]

Hi Eric,

2014ko urriak 12an, Eric Abrahamsen-ek idatzi zuen:
>> 
>> Can the above inlinetask thing also be moved into the hook?  That
>> seems cleaner, and gives another demonstration of the usefulness of
>> the feature.
> 
> Here's a patch that does it, though I'm a little more cautious about
> this since I only did a minimal test.
> 
> Two things that worry me: 1) why is it called "remove-END-maybe" when it
> appears to remove the whole inlinetask, and 2) it its original habitat
> in org-attach, it came after the call to org-cut-subtree, meaning that
> it couldn't have operated on the subtree to be archived at all! Or am I
> misunderstanding something? 

No, you’re not misunderstanding – I was.  Indeed, the inline task stuff
has to come after the call to org-cut-subtree, so it’s not a candidate
for inclusion in the new hook.

(What happens is that org-cut-subtree removes the inline task headline and
any contents, leaving a bare *** END line.  The latter is subsequently
cleaned up by the org-inlinetask-remove-END-maybe call.)

Sorry for the noise,

-- 
Aaron Ecay

Re: [PATCH RFC] subtree archive hook?

[Eric Abrahamsen]

Aaron Ecay <aaronecay@gmail.com> writes:

> Hi Eric,
>
> 2014ko urriak 12an, Eric Abrahamsen-ek idatzi zuen:
>>> 
>>> Can the above inlinetask thing also be moved into the hook?  That
>>> seems cleaner, and gives another demonstration of the usefulness of
>>> the feature.
>> 
>> Here's a patch that does it, though I'm a little more cautious about
>> this since I only did a minimal test.
>> 
>> Two things that worry me: 1) why is it called "remove-END-maybe" when it
>> appears to remove the whole inlinetask, and 2) it its original habitat
>> in org-attach, it came after the call to org-cut-subtree, meaning that
>> it couldn't have operated on the subtree to be archived at all! Or am I
>> misunderstanding something? 
>
> No, you’re not misunderstanding – I was.  Indeed, the inline task stuff
> has to come after the call to org-cut-subtree, so it’s not a candidate
> for inclusion in the new hook.
>
> (What happens is that org-cut-subtree removes the inline task headline and
> any contents, leaving a bare *** END line.  The latter is subsequently
> cleaned up by the org-inlinetask-remove-END-maybe call.)

Yup, I figured it out after another few minutes of staring at it. No
harm done, I guess!

Re: [PATCH RFC] subtree archive hook?

[Nicolas Goaziou]

Hello,

Eric Abrahamsen <eric@ericabrahamsen.net> writes:

> I think it would be useful to have a hook that runs before archiving a
> subtree. I'm attaching two patches: one that includes a hook in the
> archive process, and another (by way of an example) that adds a function
> to that hook for the org-attach library. You can set the option
> `org-attach-archive-delete' to a non-nil value to have org-attach delete
> a subtree's attachments when you archive it.
>
> Let me know what you think!

Thanks for the patch. I think it could be useful. Some comments follow.

> +(defvar org-archive-hook nil
> +  "Hook run after successfully archiving a subtree.
> +
> +Hook functions are called with point on the subtree in the
> +original file. At this stage, the subtree has been added to the

You need two spaces after full stop.

> * lisp/org-attach.el (org-attach-archive-delete): New option
>   controlling what to do with attachments when archiving.
>   (org-attach-archive-delete-maybe): New function that runs as a hook
>   on org-attach-hook. Checks the value of org-attach-archive-delete,

Two spaces are needed.

>   and behaves accordingly.
> ---
>  lisp/org-attach.el | 32 ++++++++++++++++++++++++++++++++
>  1 file changed, 32 insertions(+)
>
> diff --git a/lisp/org-attach.el b/lisp/org-attach.el
> index 5c341a5..cc077c4 100644
> --- a/lisp/org-attach.el
> +++ b/lisp/org-attach.el
> @@ -120,6 +120,18 @@ lns   create a symbol link.  Note that this is not supported
>  	  (const :tag "Link to origin location" t)
>  	  (const :tag "Link to the attach-dir location" attached)))
>  
> +(defcustom org-attach-archive-delete nil
> +  "If a subtree is archived, should its attachments be deleted?

  Non-nil means attachments are deleted upon archiving a subtree.

> +Set to nil to never delete attachments, t to always delete
> +attachments, and the symbol query to ask."

I think you only need to document the `query' symbol, e.g.,

  When set to `query', ask the user instead.

> +  :group 'org-attach
> +  :version "24.1"
> +  :type '(choice
> +	  (const :tag "Never delete attachments" nil)
> +	  (const :tag "Always delete attachments" t)
> +	  (const :tag "Query the user" query)))

You need :package-version and :version is "25.1".

>  ;;;###autoload
>  (defun org-attach ()
>    "The dispatcher for attachment commands.
> @@ -475,6 +487,26 @@ Basically, this adds the path to the attachment directory, and a \"file:\"
>  prefix."
>    (concat "file:" (org-attach-expand file)))
>  
> +(defun org-attach-archive-delete-maybe ()
> +  "Maybe delete subtree attachments when archiving.
> +
> +This function is called by `org-archive-hook'. The option

Two spaces.

> +`org-attach-archive-delete' controls its behavior."
> +  (let (delete-p)
> +    (setq delete-p
> +	  (cond
> +	   ((eq org-attach-archive-delete 'query)
> +	    (y-or-n-p "Delete all attachments?"))
> +	   ((null org-attach-archive-delete)
> +	    nil)
> +	   (org-attach-archive-delete
> +	    t)
> +	   (t nil)))
> +    (when delete-p
> +      (org-attach-delete-all t))))

  (defun org-attach-archive-delete-maybe ()
    (when (if (eq org-attach-archive-delete 'query)
              (yes-or-no-p "Delete all attachments? ")
            org-attach-archive-delete)
      (org-attach-delete-all t)))


Regards,

-- 
Nicolas Goaziou

Re: [PATCH RFC] subtree archive hook?

[Eric Abrahamsen]

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

Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:

> Hello,
>
> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
>> I think it would be useful to have a hook that runs before archiving a
>> subtree. I'm attaching two patches: one that includes a hook in the
>> archive process, and another (by way of an example) that adds a function
>> to that hook for the org-attach library. You can set the option
>> `org-attach-archive-delete' to a non-nil value to have org-attach delete
>> a subtree's attachments when you archive it.
>>
>> Let me know what you think!
>
> Thanks for the patch. I think it could be useful. Some comments follow.
>
>> +(defvar org-archive-hook nil
>> +  "Hook run after successfully archiving a subtree.
>> +
>> +Hook functions are called with point on the subtree in the
>> +original file. At this stage, the subtree has been added to the
>
> You need two spaces after full stop.
>
>> * lisp/org-attach.el (org-attach-archive-delete): New option
>>   controlling what to do with attachments when archiving.
>>   (org-attach-archive-delete-maybe): New function that runs as a hook
>>   on org-attach-hook. Checks the value of org-attach-archive-delete,
>
> Two spaces are needed.
>
>>   and behaves accordingly.
>> ---
>>  lisp/org-attach.el | 32 ++++++++++++++++++++++++++++++++
>>  1 file changed, 32 insertions(+)
>>
>> diff --git a/lisp/org-attach.el b/lisp/org-attach.el
>> index 5c341a5..cc077c4 100644
>> --- a/lisp/org-attach.el
>> +++ b/lisp/org-attach.el
>> @@ -120,6 +120,18 @@ lns   create a symbol link.  Note that this is not supported
>>  	  (const :tag "Link to origin location" t)
>>  	  (const :tag "Link to the attach-dir location" attached)))
>>  
>> +(defcustom org-attach-archive-delete nil
>> +  "If a subtree is archived, should its attachments be deleted?
>
>   Non-nil means attachments are deleted upon archiving a subtree.
>
>> +Set to nil to never delete attachments, t to always delete
>> +attachments, and the symbol query to ask."
>
> I think you only need to document the `query' symbol, e.g.,
>
>   When set to `query', ask the user instead.
>
>> +  :group 'org-attach
>> +  :version "24.1"
>> +  :type '(choice
>> +	  (const :tag "Never delete attachments" nil)
>> +	  (const :tag "Always delete attachments" t)
>> +	  (const :tag "Query the user" query)))
>
> You need :package-version and :version is "25.1".
>
>>  ;;;###autoload
>>  (defun org-attach ()
>>    "The dispatcher for attachment commands.
>> @@ -475,6 +487,26 @@ Basically, this adds the path to the attachment directory, and a \"file:\"
>>  prefix."
>>    (concat "file:" (org-attach-expand file)))
>>  
>> +(defun org-attach-archive-delete-maybe ()
>> +  "Maybe delete subtree attachments when archiving.
>> +
>> +This function is called by `org-archive-hook'. The option
>
> Two spaces.
>
>> +`org-attach-archive-delete' controls its behavior."
>> +  (let (delete-p)
>> +    (setq delete-p
>> +	  (cond
>> +	   ((eq org-attach-archive-delete 'query)
>> +	    (y-or-n-p "Delete all attachments?"))
>> +	   ((null org-attach-archive-delete)
>> +	    nil)
>> +	   (org-attach-archive-delete
>> +	    t)
>> +	   (t nil)))
>> +    (when delete-p
>> +      (org-attach-delete-all t))))
>
>   (defun org-attach-archive-delete-maybe ()
>     (when (if (eq org-attach-archive-delete 'query)
>               (yes-or-no-p "Delete all attachments? ")
>             org-attach-archive-delete)
>       (org-attach-delete-all t)))

Thanks for the review! Particularly the concision of this last. I'm
afraid I may never get used to two spaces at the end of a sentence,
though...

Eric


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0006-Provide-a-hook-during-the-archive-process.patch --]
[-- Type: text/x-diff, Size: 1682 bytes --]

From 7c0db486d247a21f88f4c2c9da71b2ad8f98abff Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Tue, 14 Oct 2014 09:38:41 +0800
Subject: [PATCH 6/7] Provide a hook during the archive process

* lisp/org-archive.el (org-archive-hook): New hook.
  (org-archive-subtree): Run hook.
---
 lisp/org-archive.el | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index 700e59b..b30185c 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -119,6 +119,13 @@ information."
 	      (const :tag "Outline path" olpath)
 	      (const :tag "Local tags" ltags)))
 
+(defvar org-archive-hook nil
+  "Hook run after successfully archiving a subtree.
+
+Hook functions are called with point on the subtree in the
+original file.  At this stage, the subtree has been added to the
+archive location, but not yet deleted from the original file.")
+
 (defun org-get-local-archive-location ()
   "Get the archive location applicable at point."
   (let ((re "^[ \t]*#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
@@ -366,8 +373,10 @@ this heading."
 	    ;; Save and kill the buffer, if it is not the same buffer.
 	    (when (not (eq this-buffer buffer))
 	      (save-buffer))))
-	;; Here we are back in the original buffer.  Everything seems to have
-	;; worked.  So now cut the tree and finish up.
+	;; Here we are back in the original buffer.  Everything seems
+	;; to have worked.  So now run hooks, cut the tree and finish
+	;; up.
+	(run-hooks 'org-archive-hook)
 	(let (this-command) (org-cut-subtree))
 	(when (featurep 'org-inlinetask)
 	  (org-inlinetask-remove-END-maybe))
-- 
2.1.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0007-Maybe-delete-heading-attachments-when-archiving.patch --]
[-- Type: text/x-diff, Size: 2050 bytes --]

From c3edec5eff41927f4e3ac2f0691228cb2df32514 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Tue, 14 Oct 2014 09:51:01 +0800
Subject: [PATCH 7/7] Maybe delete heading attachments when archiving

* lisp/org-attach.el (org-attach-archive-delete): New option
  controlling what to do with attachments when archiving.
  (org-attach-archive-delete-maybe): New function that runs as a hook
  on org-archive-hook.  Checks the value of org-attach-archive-delete,
  and behaves accordingly.
---
 lisp/org-attach.el | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index 5c341a5..f50d244 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -120,6 +120,18 @@ lns   create a symbol link.  Note that this is not supported
 	  (const :tag "Link to origin location" t)
 	  (const :tag "Link to the attach-dir location" attached)))
 
+(defcustom org-attach-archive-delete nil
+  "Non-nil means attachments are deleted upon archiving a subtree.
+
+When set to `query', ask the user instead."
+  :group 'org-attach
+  :version "25.1"
+  :package-version '(Org . "8.3")
+  :type '(choice
+	  (const :tag "Never delete attachments" nil)
+	  (const :tag "Always delete attachments" t)
+	  (const :tag "Query the user" query)))
+
 ;;;###autoload
 (defun org-attach ()
   "The dispatcher for attachment commands.
@@ -475,6 +487,18 @@ Basically, this adds the path to the attachment directory, and a \"file:\"
 prefix."
   (concat "file:" (org-attach-expand file)))
 
+(defun org-attach-archive-delete-maybe ()
+  "Maybe delete subtree attachments when archiving.
+
+This function is called by `org-archive-hook'.  The option
+`org-attach-archive-delete' controls its behavior."
+  (when (if (eq org-attach-archive-delete 'query)
+	    (yes-or-no-p "Delete all attachments? ")
+	  org-attach-archive-delete)
+    (org-attach-delete-all t)))
+
+(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe)
+
 (provide 'org-attach)
 
 ;; Local variables:
-- 
2.1.2

Re: [PATCH RFC] subtree archive hook?

[Nicolas Goaziou]

Hello,

Eric Abrahamsen <eric@ericabrahamsen.net> writes:

> Thanks for the review! Particularly the concision of this last. I'm
> afraid I may never get used to two spaces at the end of a sentence,
> though...

Patch applied. Thank you.


Regards,

-- 
Nicolas Goaziou