[elpa] externals/org 08a8c9e678 2/2: org-attach.el: ID to path functions may return nil

[ELPA Syncer]

branch: externals/org
commit 08a8c9e67822fd6340e99fd7387c2f8098510594
Author: Max Nikulin <manikulin@gmail.com>
Commit: Ihor Radchenko <yantar92@posteo.net>

    org-attach.el: ID to path functions may return nil
    
    * lisp/org-attach.el (org-attach-dir-from-id): Ignore nil values
    returned by entries from `org-attach-id-to-path-function-list'.
    (org-attach-dir-get-create): Signal an error suggesting customization
    of `org-attach-id-to-path-function-list' if all ID-to-path functions
    return nil.
    (org-attach-id-to-path-function-list): Add to the docstring examples
    how to handle unusual IDs.
    (org-attach-id-uuid-folder-format, org-attach-id-ts-folder-format):
    Return nil if ID is too short.
    (org-attach-id-fallback-folder-format): New function that may be added
    as the last element of `org-attach-id-path-function-list' to handle
    unexpectedly short IDs.
    * etc/ORG-NEWS: Advertise the change.
    
    Earlier an obscure error like 'org-attach-id-ts-folder-format: Args out
    of range: "ftt", 0, 6' was signalled in the case of unexpectedly short
    ID.
    
    Reported-by: Janek F <xerusx@pm.me>
    Link: 
https://list.orgmode.org/KC8PcypJapBpJQtJxM0kX5N7Z0THL2Lq6EQjBMzpw1-vgQf72egZ2JOIlTbPYiqAVD4MdSBhrhBZr2Ykf5DN1mocm1ANvvuKKZShlkgzKYM=@pm.me
---
 etc/ORG-NEWS       |  39 ++++++++++++++++++++
 lisp/org-attach.el | 105 ++++++++++++++++++++++++++++++++++-------------------
 2 files changed, 107 insertions(+), 37 deletions(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 04b5be64ab..78f7c5d18d 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -604,6 +604,45 @@ With the new customization option ~org-texinfo-with-latex~ 
set to (its
 default value) ~'detect~, if the system runs Texinfo 6.8 (3 July 2021)
 or newer, Org will export all LaTeX fragments and environments using
 Texinfo ~@math~ and ~@displaymath~ commands respectively.
+*** More flexible ~org-attach-id-to-path-function-list~
+
+List entries may return nil if they are unable to handle the passed
+ID.  So, responsibility is passed to the next item in the list.
+Default entries ~org-attach-id-uuid-folder-format~ and
+~org-attach-id-ts-folder-format~ now return nil for too short IDs.
+Earlier an obscure error has been thrown.
+
+After the change, error text suggests adjusting
+~org-attach-id-to-path-function-list~ value.  The
+~org-attach-dir-from-id~ function is adapted to ignore nil values and
+to take first non-nil value instead of the value returned by first
+~org-attach-id-to-path-function-list~ item.
+
+New policy allows mixing different ID styles while keeping subfolder
+layout suited best for each one.  For example, one can use the
+following snippet to allow multiple different ID formats in Org files.
+
+#+begin_src emacs-lisp
+(setq org-attach-id-to-path-function-list
+      '(;; When ID looks like an UUIDs or Org internal ID, use
+        ;; `org-attach-id-uuid-folder-format'.
+        (lambda (id)
+          (and (or (org-uuidgen-p id)
+                  (string-match-p "[0-9a-z]\\{12\\}" id))
+              (org-attach-id-uuid-folder-format id)))
+        ;; When ID looks like a timestap-based ID. Group by year-month
+        ;; folders.
+        (lambda (id)
+          (and (string-match-p "[0-9]\\{8\\}T[0-9]\\{6\\}\.[0-9]\\{6\\}" id)
+               (org-attach-id-ts-folder-format id)))
+        ;; Any other ID goes into "important" folder.
+        (lambda (id) (format "important/%s/%s" (substring id 0 1) id))
+        ;; Fallback to detect existing attachments for old defaults.
+        ;; All the above functions, even when return non-nil, would
+        ;; point to non-existing folders.
+        org-attach-id-uuid-folder-format
+        org-attach-id-ts-folder-format))
+#+end_src
 
 * Version 9.5
 
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index ef183474e7..f85811dc7f 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -166,28 +166,57 @@ 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)))
-
-(defcustom org-attach-id-to-path-function-list 
'(org-attach-id-uuid-folder-format
-                                                org-attach-id-ts-folder-format)
-  "List of functions parsing an ID string into a folder-path.
-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."
+  (and (< 6 (length id))
+       (format "%s/%s"
+               (substring id 0 6)
+               (substring id 6))))
+
+(defun org-attach-id-fallback-folder-format (id)
+  "Return \"__/X/ID\" folder path as a dumb fallback.
+X is the first character in the ID string.
+
+This function may be appended to `org-attach-id-path-function-list' to
+provide a fallback for non-standard ID values that other functions in
+`org-attach-id-path-function-list' are unable to handle.  For example,
+when the ID is too short for `org-attach-id-ts-folder-format'.
+
+However, we recommend to define a more specific function spreading
+entries over multiple folders.  This function may create a large
+number of entries in a single folder, which may cause issues on some
+systems."
+  (format "__/%s/%s" (substring id 0 1) id))
+
+(defcustom org-attach-id-to-path-function-list
+  '(org-attach-id-uuid-folder-format
+    org-attach-id-ts-folder-format
+    org-attach-id-fallback-folder-format)
+  "List of functions used to derive attachment path from an ID string.
+The functions are called with a single ID argument until the return
+value is an existing folder.  If no folder has been created yet for
+the given ID, then the first non-nil value defines the attachment
+dir to be created.
+
+Usually, the ID format passed to the functions is defined by
+`org-id-method'.  It is advised that the first function in the list do
+not generate all the attachment dirs inside the same parent dir.  Some
+file systems may have performance issues in such scenario.
+
+Care should be taken when customizing this variable.  Previously
+created attachment folders might not be correctly mapped upon removing
+functions from the list.  Then, Org will not be able to detect the
+existing attachments."
   :group 'org-attach
-  :package-version '(Org . "9.3")
+  :package-version '(Org . "9.6")
   :type '(repeat (function :tag "Function with ID as input")))
 
 (defvar org-attach-after-change-hook nil
@@ -360,7 +389,7 @@ If no attachment directory can be derived, return nil."
       (org-attach-check-absolute-path attach-dir))
      ((setq id (org-entry-get nil "ID" org-attach-use-inheritance))
       (org-attach-check-absolute-path nil)
-      (setq attach-dir (org-attach-dir-from-id id 'try-all))))
+      (setq attach-dir (org-attach-dir-from-id id 'existing))))
     (if no-fs-check
        attach-dir
       (when (and attach-dir (file-directory-p attach-dir))
@@ -381,7 +410,11 @@ If the attachment by some reason cannot be created an 
error will be raised."
          (setq answer (read-char-exclusive)))
        (cond
         ((or (eq org-attach-preferred-new-method 'id) (eq answer ?1))
-         (setq attach-dir (org-attach-dir-from-id (org-id-get nil t))))
+         (let ((id (org-id-get nil t)))
+           (or (setq attach-dir (org-attach-dir-from-id id))
+               (error "Failed to get folder for id %s, \
+adjust `org-attach-id-to-path-function-list'"
+                       id))))
         ((or (eq org-attach-preferred-new-method 'dir) (eq answer ?2))
          (setq attach-dir (org-attach-set-directory)))
         ((eq org-attach-preferred-new-method 'nil)
@@ -392,27 +425,25 @@ If the attachment by some reason cannot be created an 
error will be raised."
       (make-directory attach-dir t))
     attach-dir))
 
-(defun org-attach-dir-from-id (id  &optional try-all)
+(defun org-attach-dir-from-id (id  &optional existing)
   "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)))
+Try id-to-path functions in `org-attach-id-to-path-function-list'
+ignoring nils.  If EXISTING is non-nil, then return the first path
+found in the filesystem.  Otherwise 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 existing) (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.