I usually have a huge numbers of files, related to my projects. I would like to use attach to associate the files with the proper entry, but searching them later in my Dropbox is a pain because of the way Org saves the attachments. It makes more sense for me to make attachments follow the org tree structure in the project by default (unless I change the attach folder to something else).
This can be done if we make attachment by creating a symbolic link to the attach folder in the place, according to the headline path. This way allows to keep all the file attached to the project accessible with relative paths.
I do not handle the situation when the entry uid is being changed.. Try to look in symlinks?ENDFor the implementation, the idea is keeping all the actual attachments in a common folder for all the org files according to their uuid. As a result, I can safely refile tasks between different org files without worrying about moving the attachments around (assuming that there is not change in the task ids).
(setq org-attach-method 'mv)
(setq org-attach-store-link-p 't)
(require 'f)
(setq org-attach-id-dir "~/.data/")
(setq org-id-locations-file
(f-join org-attach-id-dir ".org-id-locations"))The above does not follow the task hierarchy of the tasks.
To implement this, for each task, I store the symlinks to the child tasks in the task’s attachment directory.
Therefore, apart from the attachments, I have yant/org-attach-symlinks-directory folder in the task’s attach dir.
This folder contains a back reference to the attachment dir (if there are attachments) yant/org-attach-attachments-symlink-directory and symlinks to the corresponding symlink folders of the children with attachments somewhere down the hierarchy.
Now, it is trivial to create the attachment hierarchy for any org file. I just make folders pointing to the yant/org-attach-symlinks-directory= of the top level tasks either in the same folder with the org file or in yant/org-attach-file-symlink-path (file local).
(setq org-attach-file-list-property nil)
(defvar-local yant/org-attach-file-symlink-path nil
"Path to directory where the symlink hierarchy is created for the current org buffer.
It is intended to be set as a file-local variable.
Use `default-directory' if nil.")
(put 'yant/org-attach-file-symlink-path 'safe-local-variable 'stringp)
(defvar yant/org-attach-attachments-symlink-directory "_data"
"Name of the symlink to the attach file folder.")
(defvar yant/org-attach-symlinks-directory ".org.symlinks"
"Name of the folder containing symlinks to the entry children attach folders.")
(define-advice org-attach-file-list (:filter-return (filelist) remove-boring-files)
"Remove local variable file and boring symlinks from the attachment file list."
(let ((symlinks-directory yant/org-attach-symlinks-directory))
(remove "flycheck_.dir-locals.el" ;; not sure where this constant is defined
(remove dir-locals-file
(remove symlinks-directory
filelist)))))
(defun yant/outline-get-next-sibling (&optional subtree-end)
"A faster version of `outline-get-next-sibling'.
Bound search by SUBTREE-END if non nil."
(let* ((level (funcall outline-level))
(sibling-regex (concat "^\\*\\{" (format "%d" level) "\\}[^*]"))
(bound (or subtree-end (point-max))))
(re-search-forward sibling-regex bound 'noerror)))
(defun yant/org-entry-name-cleanup-for-dir ()
"Format entry name to make a directory. Return nil if the entry name is empty."
(org-with-wide-buffer
(let* ((entry-name (replace-regexp-in-string "[/<>|:&/]" "-" ;; make sure that entry title can be used as a directory name
(org-get-heading 'NO-TAGS 'NO-TODO 'NO-PRIORITY 'NO-COMMENT)))
(entry-name (replace-regexp-in-string " +\\[.+\\]$" "" ;; remove statistics cookies
entry-name
))
(entry-name (replace-regexp-in-string org-link-bracket-re "\\2" ;; only leave the link names
entry-name
)))
(unless (seq-empty-p entry-name) ;; prevent empty folders
(set-text-properties 0 (length entry-name) nil entry-name)
entry-name))))
(defun yant/org-subtree-has-attachments-p ()
"Return non nil if the subtree at point has an attached file."
(org-with-wide-buffer
(when (eq major-mode 'org-mode) (org-back-to-heading))
(let ((subtree-end (save-excursion (org-end-of-subtree))))
(re-search-forward (format "^\\*+ +.*?[ ]+.*?:%s:.*?$" org-attach-auto-tag) subtree-end 'noerror))))
(defun yant/org-task-has-attachments-p ()
"Return non nil if the task at point has an attached file."
(org-with-wide-buffer
(when (eq major-mode 'org-mode) (org-back-to-heading))
(member org-attach-auto-tag (org-get-tags nil t))))
(defvar yant/--processed-entry-ids nil
"Variable used to store processed entry ids in `org-attach-dir@yant/org-attach-ensure-attach-dir-symlink'")
(define-advice org-attach-dir (:filter-return (dir) yant/org-attach-ensure-attach-dir-symlink)
"Make sure that the attach DIR for the current entry has a link in the org structure based directory structure.
The DIR is ensured to be in the symlink mirror dir structure for the entry.
Do nothing if `org-attach-dir-suppress-extra-checks' is non-nil."
(prog1
(and dir
(f-slash dir))
(when (and (equal major-mode 'org-mode)
dir
(not (bound-and-true-p org-attach-dir-suppress-extra-checks)) ;; an option to make `org-attach-dir' faster if needed
(f-exists-p dir)
(f-dir-p dir))
(let* ((attach-path dir)
(symlinks-directory (f-slash (f-join dir
yant/org-attach-symlinks-directory)))
(attachments-symlink-directory (f-slash (f-join symlinks-directory
yant/org-attach-attachments-symlink-directory)))
(org-id (org-id-get nil 'create))
(entry-name (yant/org-entry-name-cleanup-for-dir))
(attach-dir-inherited-p (and (org-entry-get-with-inheritance "ATTACH_DIR_INHERIT")
(not (org-entry-get (point) "ATTACH_DIR_INHERIT" nil)))) ;; only consider if the entry is the child
(org-attach-dir-recursive-p (bound-and-true-p org-attach-dir-recursive-p))) ;; keep track if this is the initial call of the function
(unless org-attach-dir-recursive-p (setq yant/--processed-entry-ids nil))
(unless (member org-id yant/--processed-entry-ids)
(add-to-list 'yant/--processed-entry-ids org-id)
(unless attach-dir-inherited-p
(when (f-file-p symlinks-directory)
(error (format "File exist in place of dir: %s" symlinks-directory)))
(when (and (f-exists-p attachments-symlink-directory)
(not (f-symlink-p (directory-file-name attachments-symlink-directory))))
(error (format "Not a symlink: %s" attachments-symlink-directory)))
;; update dirs
(unless (f-exists-p symlinks-directory)
(f-mkdir symlinks-directory))
(unless (or (f-exists-p attachments-symlink-directory)
(not (yant/org-task-has-attachments-p)))
;;(debug)
(f-symlink attach-path (directory-file-name attachments-symlink-directory)))
(when (and (f-exists-p attachments-symlink-directory)
(not (yant/org-task-has-attachments-p)))
(f-delete (directory-file-name attachments-symlink-directory)))
;; add to parent entry attachment dir
(unless (seq-empty-p entry-name) ;; prevent empty folder names
(org-with-wide-buffer
(let ((entry-symlink-name (if (org-up-heading-safe)
(directory-file-name (f-join (let ((org-attach-dir-recursive-p t))
(org-attach-dir 'CREATE))
yant/org-attach-symlinks-directory
entry-name))
(or yant/org-attach-file-symlink-path (hack-local-variables))
(when yant/org-attach-file-symlink-path
(unless (file-exists-p yant/org-attach-file-symlink-path) (f-mkdir yant/org-attach-file-symlink-path)))
(directory-file-name (f-join (or yant/org-attach-file-symlink-path
default-directory)
entry-name)))))
(if (not (f-exists-p entry-symlink-name))
(progn
;;(debug)
(f-symlink symlinks-directory (directory-file-name entry-symlink-name)))
(unless (f-symlink-p entry-symlink-name)
(error (format "File exists: %s" entry-symlink-name)))))))
;; check children
(when (yant/org-subtree-has-attachments-p)
(let ((dirs (delete (directory-file-name attachments-symlink-directory)
(f-directories symlinks-directory))))
(org-with-wide-buffer
(org-back-to-heading)
(let ((subtree-end (save-excursion (org-end-of-subtree))))
(forward-line 1)
(when (re-search-forward org-heading-regexp subtree-end t)
(while (< (point) subtree-end)
(when (yant/org-entry-name-cleanup-for-dir)
(let ((child-dir (f-join symlinks-directory (yant/org-entry-name-cleanup-for-dir))))
(when (yant/org-subtree-has-attachments-p)
(unless (member child-dir dirs)
(let ((org-attach-dir-recursive-p t))
(org-attach-dir 'CREATE)))
(setq dirs (delete child-dir dirs)))))
(or (yant/outline-get-next-sibling subtree-end)
(goto-char subtree-end))))))
(mapc (lambda (d)
(let ((dir (f-long d)))
(when (f-symlink-p (directory-file-name dir))
(f-delete dir) ; delete the dirs, which do not point to children
)))
dirs)))))))))Now, when I have the mirror attach folder structure, it make sense to open this structure on org-attach-reveal instead of opening the actual attach dirs.
(defun org-attach-dir-symlink (&optional create-if-not-exists-p no-fs-check no-data-dir)
"Return symlink based path to the attach dir of current entry.
Do not append symlink to data directory if NO-DATA-dir is not nil."
(org-with-point-at-org-buffer
(if create-if-not-exists-p
(let ((symlink (org-attach-dir-symlink nil nil no-data-dir)))
(if (not (f-exists-p symlink))
(org-attach-dir 't))
symlink))
(let* ((entry-name (yant/org-entry-name-cleanup-for-dir))
(attach-dir-inherited-p (and (org-entry-get-with-inheritance "ATTACH_DIR_INHERIT")
(not (org-entry-get (point) "ATTACH_DIR_INHERIT" nil))));; only consider if the entry is the child
(entry-path (and entry-name
(f-join entry-name (if no-data-dir "" yant/org-attach-attachments-symlink-directory)))))
(if attach-dir-inherited-p
(org-with-wide-buffer
(org-up-heading-safe) ;; if this is false, something went really wrong
(org-attach-dir-symlink create-if-not-exists-p nil no-data-dir))
(unless (seq-empty-p entry-name) ;; prevent empty folders
(org-with-wide-buffer
(if (org-up-heading-safe)
(let ((head-path (org-attach-dir-symlink create-if-not-exists-p nil 't)))
(when head-path (f-slash (f-join head-path entry-path))))
(f-slash (f-join (or yant/org-attach-file-symlink-path
default-directory)
entry-path)))))))))
(define-advice org-attach-reveal (:around (OLDFUN) reveal-symlink)
"Go to symlink attach dir structure instead of an actual attach dir."
(let ((dir (org-attach-dir))
(attach-dir-inherited-p (and (org-entry-get-with-inheritance "ATTACH_DIR_INHERIT")
(not (org-entry-get (point) "ATTACH_DIR_INHERIT" nil))));; only consider if the entry is the child
)
(org-attach-sync)
(letf (((symbol-function 'org-attach-dir) (if (yant/org-task-has-attachments-p)
#'org-attach-dir-symlink
(lambda (&rest args)
(if (yant/org-subtree-has-attachments-p)
(org-attach-dir-symlink 't nil 't)
dir
)))))
(when attach-dir-inherited-p (org-attach-tag 'off))
(funcall OLDFUN))))
(define-advice org-attach-reveal-in-emacs (:around (OLDFUN &rest args) reveal-symlink)
#'org-attach-reveal@reveal-symlink)Files, out of the folder structure, will appear in my agenda to attach them to the relevant project (unless explicitly specified in special variable).
implement thisEND- State “DONE” from “TODO” [2019-12-21 Sat 20:30]
- State “NEXT” from “TODO” [2018-08-27 Mon 08:39]