emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATCH RFC] subtree archive hook?
@ 2014-10-12 14:27 Eric Abrahamsen
  2014-10-12 15:22 ` Aaron Ecay
  2014-10-13 16:13 ` Nicolas Goaziou
  0 siblings, 2 replies; 8+ messages in thread
From: Eric Abrahamsen @ 2014-10-12 14:27 UTC (permalink / raw)
  To: emacs-orgmode

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


^ permalink raw reply related	[flat|nested] 8+ messages in thread
end of thread, other threads:[~2014-10-16 17:02 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-10-12 14:27 [PATCH RFC] subtree archive hook? Eric Abrahamsen
2014-10-12 15:22 ` Aaron Ecay
2014-10-12 16:10   ` Eric Abrahamsen
2014-10-12 18:13     ` Aaron Ecay
2014-10-12 18:45       ` Eric Abrahamsen
2014-10-13 16:13 ` Nicolas Goaziou
2014-10-14  1:55   ` Eric Abrahamsen
2014-10-16 17:03     ` Nicolas Goaziou

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).