From d156a9cfcdbfb9be72df39761111e2355f48cf10 Mon Sep 17 00:00:00 2001
From: Jack Kamm <jackkamm@gmail.com>
Date: Wed, 28 Oct 2020 17:29:04 -0700
Subject: [PATCH] ol.el: New option to set org-link-file-path-type to a
 function

* lisp/ol.el (org-link-file-path-type): Add new option.
(org-insert-link): Handle function option for org-link-file-path-type.
---
 etc/ORG-NEWS | 19 +++++++++++++++++++
 lisp/ol.el   | 12 ++++++++++--
 2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 7f935bf52..891a680ae 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -35,6 +35,25 @@ omit a file description was to omit the header argument entirely,
 which made it difficult/impossible to provide a default value for
 =file-desc=.
 
+*** New option to set ~org-link-file-path-type~ to a function
+
+If ~org-link-file-path-type~ can now be set to a function that takes
+the full filename as an argument and returns the path to link to.
+
+For example, if you use ~project.el~, you can set this function to use
+relative links within a project as follows:
+
+#+begin_src emacs-lisp
+(setq (org-link-file-path-type
+       (lambda (path)
+         (let* ((proj (project-current))
+                (root (if proj (project-root proj) default-directory)))
+           (if (string-prefix-p (expand-file-name root) path)
+               (progn
+                 (file-relative-name path))
+             (abbreviate-file-name path))))))
+#+end_src
+
 ** New features
 *** =ob-python= improvements to =:return= header argument 
 
diff --git a/lisp/ol.el b/lisp/ol.el
index 951bb74e7..262a6c5ae 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -212,13 +212,18 @@ (defcustom org-link-file-path-type 'adaptive
 absolute  Absolute path, if possible with ~ for home directory.
 noabbrev  Absolute path, no abbreviation of home directory.
 adaptive  Use relative path for files in the current directory and sub-
-          directories of it.  For other files, use an absolute path."
+          directories of it.  For other files, use an absolute path.
+
+Alternatively, users may supply a custom function that takes the
+full filename as an argument and returns the path."
   :group 'org-link
   :type '(choice
 	  (const relative)
 	  (const absolute)
 	  (const noabbrev)
-	  (const adaptive))
+	  (const adaptive)
+	  (function))
+  :package-version '(Org . "9.5")
   :safe #'symbolp)
 
 (defcustom org-link-abbrev-alist nil
@@ -1876,6 +1881,9 @@ (defun org-insert-link (&optional complete-file link-location description)
 	    (setq path (expand-file-name path)))
 	   ((eq org-link-file-path-type 'relative)
 	    (setq path (file-relative-name path)))
+	   ((functionp org-link-file-path-type)
+	    (setq path (funcall org-link-file-path-type
+				(expand-file-name path))))
 	   (t
 	    (save-match-data
 	      (if (string-match (concat "^" (regexp-quote
-- 
2.29.2