branch: externals/org
commit dd24af375d7e5787def04c14f105fa1c9c586f79
Author: Visuwesh <visuwe...@gmail.com>
Commit: Ihor Radchenko <yanta...@posteo.net>
Respect `org-file-link-type' in `yank-media' and DND handlers
* lisp/ol.el (org-link--normalize-filename): New function...
(org-insert-link): extracted from here. Use it
* lisp/org.el (org--image-yank-media-handler)
(org--dnd-local-file-handler, org--dnd-attach-file)
(org--dnd-xds-function): Respect the value of `org-file-link-type'
when inserting file: links.
* etc/ORG-NEWS (Miscellaneous): Announce the change.
Reported-by: pinmacs <pinm...@cas.cat>
Link:
https://list.orgmode.org/orgmode/a7d4e731-1af6-4ce9-9f4d-d49ddcf57...@cas.cat
---
etc/ORG-NEWS | 5 +++++
lisp/ol.el | 51 ++++++++++++++++++++++++++++++---------------------
lisp/org.el | 23 ++++++++++++++---------
3 files changed, 49 insertions(+), 30 deletions(-)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 7f067481e2..a878f37762 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -431,6 +431,11 @@ capture ~:tree-type~ options]], the internal variable
undocumented helper function ~org-datetree-insert-line~.
** Miscellaneous
+*** ~yank-media~ and DND handlers now honor the user option
~org-file-link-type~
+
+When inserting file: links, ~yank-media~ and DND handlers now respect
+the user option ~org-file-link-type~.
+
*** ox-man: Support specifying =#+DATE:= and ~org-export-with-date~
Previously, ox-man ignored =#+DATE:= keyword even when
diff --git a/lisp/ol.el b/lisp/ol.el
index b456f79e69..55c0dadfbe 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -2565,6 +2565,31 @@ NAME."
(org-link--add-to-stored-links link desc)))
(car org-stored-links)))))
+(defun org-link--normalize-filename (filename &optional method)
+ "Return FILENAME as required by METHOD.
+METHOD defaults to the value of `org-link-file-path-type'."
+ (setq method (or method org-link-file-path-type))
+ (cond
+ ((eq method 'absolute)
+ (abbreviate-file-name (expand-file-name filename)))
+ ((eq method 'noabbrev)
+ (expand-file-name filename))
+ ((eq method 'relative)
+ (file-relative-name filename))
+ ((functionp method)
+ (funcall method filename))
+ (t
+ (save-match-data
+ (if (string-match (concat "^" (regexp-quote
+ (expand-file-name
+ (file-name-as-directory
+ default-directory))))
+ (expand-file-name filename))
+ ;; We are linking a file with relative path name.
+ (substring (expand-file-name filename)
+ (match-end 0))
+ (abbreviate-file-name (expand-file-name filename)))))))
+
;;;###autoload
(defun org-insert-link (&optional complete-file link-location description)
"Insert a link. At the prompt, enter the link.
@@ -2752,27 +2777,11 @@ non-interactively, don't allow editing the default
description."
link path-start (match-beginning 0))
(substring-no-properties link (match-end 0))))
(origpath path))
- (cond
- ((or (eq org-link-file-path-type 'absolute)
- (equal complete-file '(16)))
- (setq path (abbreviate-file-name (expand-file-name path))))
- ((eq org-link-file-path-type 'noabbrev)
- (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 path)))
- (t
- (save-match-data
- (if (string-match (concat "^" (regexp-quote
- (expand-file-name
- (file-name-as-directory
- default-directory))))
- (expand-file-name path))
- ;; We are linking a file with relative path name.
- (setq path (substring (expand-file-name path)
- (match-end 0)))
- (setq path (abbreviate-file-name (expand-file-name path)))))))
+ (setq path (org-link--normalize-filename
+ path
+ (if (equal complete-file '(16))
+ 'absolute
+ org-link-file-path-type)))
(setq link (concat type path (and search (concat "::" search))))
(when (equal desc origpath)
(setq desc path)))))
diff --git a/lisp/org.el b/lisp/org.el
index d735edb7f0..bc61a7c462 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -20455,8 +20455,7 @@ end."
filename
(if (eq org-yank-image-save-method 'attach)
temporary-file-directory
- org-yank-image-save-method)))
- link)
+ org-yank-image-save-method))))
(when (and (not (eq org-yank-image-save-method 'attach))
(not (file-directory-p org-yank-image-save-method)))
(make-directory org-yank-image-save-method t))
@@ -20466,11 +20465,12 @@ end."
(with-temp-file absname
(insert data)))
(if (null (eq org-yank-image-save-method 'attach))
- (setq link (org-link-make-string (concat "file:" (file-relative-name
absname))))
+ (insert (org-link-make-string
+ (concat "file:"
+ (org-link--normalize-filename absname))))
(require 'org-attach)
(org-attach-attach absname nil 'mv)
- (setq link (org-link-make-string (concat "attachment:" filename))))
- (insert link)))
+ (insert (org-link-make-string (concat "attachment:" filename))))))
;; I cannot find a spec for this but
;; https://indigo.re/posts/2021-12-21-clipboard-data.html and pcmanfm
@@ -20600,7 +20600,9 @@ in which case, space is inserted."
(`open (dnd-open-local-file url action))
(`file-link
(let ((filename (dnd-get-local-file-name url)))
- (insert (org-link-make-string (concat "file:" filename))
separator))))))
+ (insert (org-link-make-string
+ (concat "file:" (org-link--normalize-filename filename)))
+ separator))))))
(defun org--dnd-attach-file (url action separator)
"Attach filename given by URL using method pertaining to ACTION.
@@ -20648,8 +20650,9 @@ SEPARATOR is the string to insert after each link."
"file:"
"attachment:")
(if separatep
- (expand-file-name (file-name-nondirectory filename)
- org-yank-image-save-method)
+ (org-link--normalize-filename
+ (expand-file-name (file-name-nondirectory filename)
+ org-yank-image-save-method))
(file-name-nondirectory filename))))
separator)
'private))
@@ -20677,7 +20680,9 @@ When NEED-NAME is nil, the drop is complete."
(pcase org--dnd-xds-method
(`attach (insert (org-link-make-string
(concat "attachment:" (file-name-nondirectory
filename)))))
- (`file-link (insert (org-link-make-string (concat "file:" filename))))
+ (`file-link (insert (org-link-make-string
+ (concat "file:"
+ (org-link--normalize-filename filename)))))
(`open (find-file filename)))
(setq-local org--dnd-xds-method nil)))
