diff --git a/lisp/org-attach.el b/lisp/org-attach.el index 8509a6564..c4d043fb9 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -163,18 +163,27 @@ When set to `query', ask the user instead." "Translate an UUID ID into a folder-path. Default format for how Org translates ID properties to a path for attachments. Useful if ID is generated with UUID." - (format "%s/%s" - (substring id 0 2) - (substring id 2))) + (and (< 2 (length id)) + (format "%s/%s" + (substring id 0 2) + (substring id 2)))) (defun org-attach-id-ts-folder-format (id) "Translate an ID based on a timestamp to a folder-path. Useful way of translation if ID is generated based on ISO8601 timestamp. Splits the attachment folder hierarchy into year-month, the rest." - (format "%s/%s" - (substring id 0 6) - (substring id 6))) + (and (< 6 (length id)) + (format "%s/%s" + (substring id 0 6) + (substring id 6)))) + +(defun org-attach-id-fallback-folder-format (id) + "May be added last to `org-attach-id-path-function-list'. +A fallback as \"__/ID\" directory for the case when user +changed ID value to a string too short for `org-attach-id-ts-folder-format' +and other functions." + (format "__/%s" id)) (defcustom org-attach-id-to-path-function-list '(org-attach-id-uuid-folder-format org-attach-id-ts-folder-format) @@ -182,7 +191,18 @@ year-month, the rest." The first function in this list defines the preferred function which will be used when creating new attachment folders. All functions of this list will be tried when looking for existing -attachment folders based on ID." +attachment folders based on ID. + +Add `org-attach-id-fallback-folder-format' to the end if you edit +IDs to short value, but you can not implement a better variant of +layout. Consider something like the following as first element instead + + (defun my/attach-id-custom-folder-format (id) + (unless + (or (string-match-p \"[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}\" id) + (string-match-p \"[0-9]{8}T[0-9]{6}\\.[0-9]{6}\" id)) + (format \"important/%s/%s\" (substring id 0 1) (substring id 1)))) +" :group 'org-attach :package-version '(Org . "9.3") :type '(repeat (function :tag "Function with ID as input"))) @@ -384,7 +404,8 @@ If the attachment by some reason cannot be created an error will be raised." ((eq org-attach-preferred-new-method 'nil) (error "No existing directory. DIR or ID property has to be explicitly created"))))) (unless attach-dir - (error "No attachment directory is associated with the current node")) + (error "No attachment directory is associated with the current node, \ +adjust `org-attach-id-to-path-function-list'")) (unless (file-directory-p attach-dir) (make-directory attach-dir t)) attach-dir)) @@ -393,23 +414,22 @@ If the attachment by some reason cannot be created an error will be raised." "Return a folder path based on `org-attach-id-dir' and ID. If TRY-ALL is non-nil, try all id-to-path functions in `org-attach-id-to-path-function-list' and return the first path -that exist in the filesystem, or the first one if none exist. -Otherwise only use the first function in that list." - (let ((attach-dir-preferred (expand-file-name - (funcall (car org-attach-id-to-path-function-list) id) - (expand-file-name org-attach-id-dir)))) - (if try-all - (let ((attach-dir attach-dir-preferred) - (fun-list (cdr org-attach-id-to-path-function-list))) - (while (and fun-list (not (file-directory-p attach-dir))) - (setq attach-dir (expand-file-name - (funcall (car fun-list) id) - (expand-file-name org-attach-id-dir))) - (setq fun-list (cdr fun-list))) - (if (file-directory-p attach-dir) - attach-dir - attach-dir-preferred)) - attach-dir-preferred))) +that exist in the filesystem, otherwise independently of TRY-ALL +value return the first non nil value." + (let ((fun-list org-attach-id-to-path-function-list) + (base-dir (expand-file-name org-attach-id-dir)) + preferred first) + (while (and fun-list + (not preferred)) + (let* ((name (funcall (car fun-list) id)) + (candidate (and name (expand-file-name name base-dir)))) + (setq fun-list (cdr fun-list)) + (when candidate + (if (or (not try-all) (file-directory-p candidate)) + (setq preferred candidate) + (unless first + (setq first candidate)))))) + (or preferred first))) (defun org-attach-check-absolute-path (dir) "Check if we have enough information to root the attachment directory.