Nicolas Goaziou <m...@nicolasgoaziou.fr> writes: > Hello, > > Eric Abrahamsen <e...@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
>From 7c0db486d247a21f88f4c2c9da71b2ad8f98abff Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen <e...@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
>From c3edec5eff41927f4e3ac2f0691228cb2df32514 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen <e...@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
