From mboxrd@z Thu Jan 1 00:00:00 1970 From: Eric Abrahamsen Subject: [PATCH RFC] subtree archive hook? Date: Sun, 12 Oct 2014 22:27:34 +0800 Message-ID: <87vbnp2wix.fsf@ericabrahamsen.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:42126) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XdK33-0006Ui-HV for emacs-orgmode@gnu.org; Sun, 12 Oct 2014 10:23:07 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XdK2x-0007ZA-8a for emacs-orgmode@gnu.org; Sun, 12 Oct 2014 10:23:01 -0400 Received: from plane.gmane.org ([80.91.229.3]:37108) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XdK2w-0007VF-Ue for emacs-orgmode@gnu.org; Sun, 12 Oct 2014 10:22:55 -0400 Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1XdK2u-0001b2-Q5 for emacs-orgmode@gnu.org; Sun, 12 Oct 2014 16:22:52 +0200 Received: from 114.248.11.237 ([114.248.11.237]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 12 Oct 2014 16:22:52 +0200 Received: from eric by 114.248.11.237 with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 12 Oct 2014 16:22:52 +0200 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-Provide-a-hook-during-the-archive-process.patch >From 1bfc84570f29dd884c2759dfe19116f09228ed4e Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0003-Maybe-delete-heading-attachments-when-archiving.patch >From f6b9bc0e2cef23b87ec77ddb9003c0791f992a2f Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen 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 --=-=-=--