[ஞாயிறு பிப்ரவரி 23, 2025] Ihor Radchenko wrote:
> Visuwesh <visuwe...@gmail.com> writes: > >>> Visuwesh, do you want to proceed with this part? >> >> Do we only want this for images, or for everything? Everything entails >> images, all dropped files, dropped image files only, and XDND. > > Everything, I think. > >> This would warrant a NEWS entry too, right? > > Indeed. > >> +(defun org-link--normalise-filename (filename &optional absolute-always) >> + "Return FILENAME as required by the value of `org-link-file-path-type'. >> +When ABSOLUTE-ALWAYS is non-nil, always return an absolute and >> +abbreviated filename." > > ABSOLUTE-ALWAYS should not be necessary. The caller may simply let-bind > `org-link-file-path-type'. Alternatively, you may avoid using dynamic > scope and simply pass org-link-file-path-type as the second argument. I went with a slightly different approach in the attached where an optional argument is accepted by the function, defaulting to the value of org-link-file-path-type.
>From 448387e7645623f29446986d529ce0b388477f77 Mon Sep 17 00:00:00 2001 From: Visuwesh <visuwe...@gmail.com> Date: Tue, 25 Feb 2025 11:17:34 +0530 Subject: [PATCH] Respect `org-file-link-type' in `yank-media' and DND handlers * lisp/ol.el (org-link--normalise-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 | 49 ++++++++++++++++++++++++++++--------------------- lisp/org.el | 23 ++++++++++++++--------- 3 files changed, 47 insertions(+), 30 deletions(-) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 9eb4f711c..e39e06b9e 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -416,6 +416,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 b456f79e6..e6acf5ad6 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -2565,6 +2565,31 @@ (defun org-store-link (arg &optional interactive?) (org-link--add-to-stored-links link desc))) (car org-stored-links))))) +(defun org-link--normalise-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,9 @@ (defun org-insert-link (&optional complete-file link-location 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--normalise-filename path (if (equal complete '(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 d012819a9..6e56f7a00 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -20450,8 +20450,7 @@ (defun org--image-yank-media-handler (mimetype data) 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)) @@ -20461,11 +20460,12 @@ (defun org--image-yank-media-handler (mimetype data) (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--normalise-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 @@ -20595,7 +20595,9 @@ (defun org--dnd-local-file-handler (url action &optional separator) (`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--normalise-filename filename))) + separator)))))) (defun org--dnd-attach-file (url action separator) "Attach filename given by URL using method pertaining to ACTION. @@ -20643,8 +20645,9 @@ (defun org--dnd-attach-file (url action separator) "file:" "attachment:") (if separatep - (expand-file-name (file-name-nondirectory filename) - org-yank-image-save-method) + (org-link--normalise-filename + (expand-file-name (file-name-nondirectory filename) + org-yank-image-save-method)) (file-name-nondirectory filename)))) separator) 'private)) @@ -20672,7 +20675,9 @@ (defun org--dnd-xds-function (need-name filename) (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--normalise-filename filename))))) (`open (find-file filename))) (setq-local org--dnd-xds-method nil))) -- 2.47.2
