From mboxrd@z Thu Jan 1 00:00:00 1970 From: Eric Abrahamsen Subject: [PATCH] Re: function for cleaning org-attach directories Date: Sat, 01 Aug 2015 17:23:40 +0800 Message-ID: <874mkjfjkz.fsf_-_@ericabrahamsen.net> References: <877fq0o4xx.fsf@ericabrahamsen.net> <87d1zs46jm.fsf@ericabrahamsen.net> <87vbdjico8.fsf@ericabrahamsen.net> <874ml2f9ce.fsf@ericabrahamsen.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:46472) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZLT1E-0003nt-UA for emacs-orgmode@gnu.org; Sat, 01 Aug 2015 05:23:54 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZLT1B-0007yU-Nq for emacs-orgmode@gnu.org; Sat, 01 Aug 2015 05:23:52 -0400 Received: from plane.gmane.org ([80.91.229.3]:60011) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZLT1B-0007xy-Gv for emacs-orgmode@gnu.org; Sat, 01 Aug 2015 05:23:49 -0400 Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1ZLT19-0003to-FM for emacs-orgmode@gnu.org; Sat, 01 Aug 2015 11:23:47 +0200 Received: from 111.197.155.106 ([111.197.155.106]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sat, 01 Aug 2015 11:23:47 +0200 Received: from eric by 111.197.155.106 with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sat, 01 Aug 2015 11:23:47 +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; charset=utf-8 Content-Transfer-Encoding: 8bit Alan Schmitt writes: > On 2015-07-18 05:11, Eric Abrahamsen writes: > >> Alan Schmitt writes: >> >>> I gave this a try and it seems that `org-attach-directory' needs to be >>> defined for it to work. I'm surprised because I never configured this >>> and with gnorb I have had files attached using org-attach. Does gnorb >>> use a default value for this? >> >> Gnorb has calls to (require 'org-attach) in certain places -- unless >> you've loaded and used gnorb in your current session, you'll probably >> want to require that yourself. > > Ah, yes, of course. It seems to be working, but it’s awfully silent. It > would be great if it gave some feedback (I don’t know if it actually > deleted anything, as there was nothing in the *Messages* buffer). Whoops, forgot about this! Feedback is a very good idea. I'm sending another version, this time as a patch in case this is something that would be welcome in Org proper. Eric --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-org-attach.el-New-function-to-delete-unused-dirs.patch >From 03a8ddacf004d49a51eb7b0b48660fc31da955ac Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 1 Aug 2015 17:19:49 +0800 Subject: [PATCH] org-attach.el: New function to delete unused dirs * lisp/org-attach.el (org-attach-clean-dirs): New function. --- lisp/org-attach.el | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/lisp/org-attach.el b/lisp/org-attach.el index 7f61910..84dc5a0 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -498,6 +498,39 @@ This function is called by `org-archive-hook'. The option (add-hook 'org-archive-hook 'org-attach-archive-delete-maybe) +(defun org-attach-clean-dirs (&optional attach-dir clean-archived) + "Delete attach directories (and their contents) for headings +which no longer exist." + (interactive) + (let ((attach-dir + (if attach-dir + (file-name-as-directory attach-dir) + (concat (file-name-as-directory org-directory) + org-attach-directory))) + (valid-dir-re "\\`[0-9a-z-]+\\'") + (org-id-search-archives (if clean-archived nil org-id-search-archives)) + dead-dirs) + (dolist (d (directory-files attach-dir nil valid-dir-re)) + (dolist (d+ (directory-files + (concat attach-dir d) nil valid-dir-re)) + (let ((id (format "%s%s" d d+)) + (full-path (concat + attach-dir + (file-name-as-directory d) + d+))) + (unless (org-id-find id) + (push full-path dead-dirs))))) + (if dead-dirs + (progn + (message "Deleting %d dead attach directories..." (length dead-dirs)) + (mapcar + (lambda (d) + (with-demoted-errors + (delete-directory d t))) + dead-dirs) + (message "Deleting %d dead attach directories... done")) + (message "No dead directories to delete.")))) + (provide 'org-attach) ;; Local variables: -- 2.5.0 --=-=-=--