From e5ccffcf617f3d04d97840873c0b16913eb65369 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 20 Feb 2020 09:29:21 +0100 Subject: [PATCH] Do not leak "attachment" links * lisp/ol.el (org-link-open): Remove "attachment" for special cases. * lisp/org-attach.el (org-attach-expand-links): (org-attach-follow): New functions. (org-attach-link-expand): Remove function. * lisp/org-element.el (org-element-link-parser): * lisp/ox-ascii.el (org-ascii-link): * lisp/ox-html.el (org-html-link): * lisp/ox-latex.el (org-latex--inline-image): (org-latex-link): * lisp/ox-man.el (org-man-link): * lisp/ox-md.el (org-md-link): * lisp/ox-odt.el (org-odt-inline-image-rules): (org-odt-link): * lisp/ox-texinfo.el (org-texinfo-inline-image-rules): (org-texinfo-link): Remove "attachment" from special cases. --- lisp/ol.el | 5 +---- lisp/org-attach.el | 45 +++++++++++++++++++++++++++++++-------------- lisp/org-element.el | 10 +++++----- lisp/ox-ascii.el | 23 +++++++++-------------- lisp/ox-html.el | 6 +----- lisp/ox-latex.el | 23 ++++++++--------------- lisp/ox-man.el | 17 ++++++----------- lisp/ox-md.el | 10 ++-------- lisp/ox-odt.el | 11 ++--------- lisp/ox-texinfo.el | 10 +--------- 10 files changed, 66 insertions(+), 94 deletions(-) diff --git a/lisp/ol.el b/lisp/ol.el index 76454d2db..e9bed3972 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -75,7 +75,6 @@ (declare-function org-src-source-type "org-src" ()) (declare-function org-time-stamp-format "org" (&optional long inactive)) (declare-function outline-next-heading "outline" ()) -(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name)) ;;; Customization @@ -1027,9 +1026,7 @@ for internal and \"file\" links, or stored as a parameter in (pcase type ;; Opening a "file" link requires special treatment since we ;; first need to integrate search option, if any. - ((or "file" "attachment") - (when (string= type "attachment") - (setq path (org-attach-link-expand link))) + ("file" (let* ((option (org-element-property :search-option link)) (path (if option (concat path "::" option) path))) (org-link-open-as-file path diff --git a/lisp/org-attach.el b/lisp/org-attach.el index d073291a2..97a7236e4 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -41,6 +41,8 @@ (declare-function dired-dwim-target-directory "dired-aux") (declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-export-link-as-file "org-export" (path description backend info)) (defgroup org-attach nil "Options concerning attachments in Org mode." @@ -646,22 +648,36 @@ See `org-attach-open'." Basically, this adds the path to the attachment directory." (expand-file-name file (org-attach-dir))) -(defun org-attach-link-expand (link &optional buffer-or-name) - "Return the full path to the attachment in the LINK element. -Takes LINK which is a link element, as defined by -`org-element-link-parser'. If LINK `:type' is attachment the -full path to the attachment is expanded and returned. Otherwise, -return nil. If BUFFER-OR-NAME is specified, LINK is expanded in -that buffer, otherwise current buffer is assumed." - (let ((type (org-element-property :type link)) - (file (org-element-property :path link)) - (pos (org-element-property :begin link))) - (when (string= type "attachment") - (with-current-buffer (or buffer-or-name (current-buffer)) - (goto-char pos) - (org-attach-expand file))))) +(defun org-attach-expand-links (_) + "Expand links in current buffer. +It is meant to be added to `org-export-before-parsing-hook'." + (save-excursion + (while (re-search-forward "attachment:" nil t) + (let ((link (org-element-context))) + (when (and (eq 'link (org-element-type link)) + (string-equal "attachment" + (org-element-property :type link))) + (let* ((description (and (org-element-property :contents-begin link) + (buffer-substring-no-properties + (org-element-property :contents-begin link) + (org-element-property :contents-end link)))) + (file (org-element-property :path link)) + (new-link (org-link-make-string + (concat "attachment:" (org-attach-expand file)) + description))) + (goto-char (org-element-property :end link)) + (skip-chars-backward " \t") + (delete-region (org-element-property :begin link) (point)) + (insert new-link))))))) + +(defun org-attach-follow (file arg) + "Open FILE attachment. +See `org-open-file' for details about ARG." + (org-link-open-as-file (org-attach-expand file) arg)) (org-link-set-parameters "attachment" + :follow #'org-attach-follow + :export #'org-export-link-as-file :complete #'org-attach-complete-link) (defun org-attach-complete-link () @@ -729,6 +745,7 @@ Idea taken from `gnus-dired-attach'." (add-hook 'org-archive-hook 'org-attach-archive-delete-maybe) +(add-hook 'org-export-before-parsing-hook 'org-attach-expand-links) (provide 'org-attach) diff --git a/lisp/org-element.el b/lisp/org-element.el index 575a568a2..798c540e9 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -3210,11 +3210,11 @@ Assume point is at the beginning of the link." (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))) (setq end (point))) - ;; Special "file" or "attachment" type link processing. Extract - ;; opening application and search option, if any. Also - ;; normalize URI. - (when (string-match "\\`\\(file\\|attachment\\)\\(?:\\+\\(.+\\)\\)?\\'" type) - (setq application (match-string 2 type) type (match-string 1 type)) + ;; Special "file"-type link processing. Extract opening + ;; application and search option, if any. Also normalize URI. + (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type) + (setq application (match-string 1 type)) + (setq type "file") (when (string-match "::\\(.*\\)\\'" path) (setq search-option (match-string 1 path)) (setq path (replace-match "" nil nil path))) diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index 981a7660e..e5240f5c8 100644 --- a/lisp/ox-ascii.el +++ b/lisp/ox-ascii.el @@ -34,7 +34,6 @@ ;;; Function Declarations (declare-function aa2u "ext:ascii-art-to-unicode" ()) -(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name)) ;;; Define Back-End ;; @@ -1571,18 +1570,13 @@ CONTENTS is nil. INFO is a plist holding contextual DESC is the description part of the link, or the empty string. INFO is a plist holding contextual information." - (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - (path (cond - ((string= type "attachment") - (setq raw-path (org-attach-link-expand link)) - (concat type ":" raw-path)) - (t (concat type ":" raw-path))))) + (let ((type (org-element-property :type link))) (cond ((org-export-custom-protocol-maybe link desc 'ascii info)) ((string= type "coderef") - (format (org-export-get-coderef-format path desc) - (org-export-resolve-coderef path info))) + (let ((ref (org-element-property :path link))) + (format (org-export-get-coderef-format ref desc) + (org-export-resolve-coderef ref info)))) ;; Do not apply a special syntax on radio links. Though, use ;; transcoded target's contents as output. ((string= type "radio") desc) @@ -1614,10 +1608,11 @@ INFO is a plist holding contextual information." ;; Don't know what to do. Signal it. (_ "???")))) (t - (if (not (org-string-nw-p desc)) (format "<%s>" path) - (concat (format "[%s]" desc) - (and (not (plist-get info :ascii-links-to-notes)) - (format " (<%s>)" path)))))))) + (let ((path (org-element-property :raw-link link))) + (if (not (org-string-nw-p desc)) (format "<%s>" path) + (concat (format "[%s]" desc) + (and (not (plist-get info :ascii-links-to-notes)) + (format " (<%s>)" path))))))))) ;;;; Node Properties diff --git a/lisp/ox-html.el b/lisp/ox-html.el index e77cd3b12..602c5390c 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -42,7 +42,6 @@ (declare-function org-id-find-id-file "org-id" (id)) (declare-function htmlize-region "ext:htmlize" (beg end)) (declare-function mm-url-decode-entities "mm-url" ()) -(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name)) (defvar htmlize-css-name-prefix) (defvar htmlize-output-type) @@ -814,7 +813,6 @@ link to the image." (defcustom org-html-inline-image-rules `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg"))) - ("attachment" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg"))) ("http" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg"))) ("https" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))) "Rules characterizing image files that can be inlined into HTML. @@ -2996,9 +2994,7 @@ INFO is a plist holding contextual information. See (cond ((member type '("http" "https" "ftp" "mailto" "news")) (url-encode-url (concat type ":" raw-path))) - ((member type '("file" "attachment")) - (when (string= type "attachment") - (setq raw-path (org-attach-link-expand link))) + ((string= "file" type) ;; During publishing, turn absolute file names belonging ;; to base directory into relative file names. Otherwise, ;; append "file" protocol to absolute file name. diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 6540d1e70..c0af8157d 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -32,8 +32,6 @@ ;;; Function Declarations -(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name)) - (defvar org-latex-default-packages-alist) (defvar org-latex-packages-alist) (defvar orgtbl-exp-regexp) @@ -741,8 +739,6 @@ environment." (defcustom org-latex-inline-image-rules `(("file" . ,(regexp-opt - '("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg"))) - ("attachment" . ,(regexp-opt '("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg")))) "Rules characterizing image files that can be inlined into LaTeX. @@ -2366,9 +2362,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." LINK is the link pointing to the inline image. INFO is a plist used as a communication channel." (let* ((parent (org-export-get-parent-element link)) - (path (let ((raw-path (if (string= (org-element-property :type link) "attachment") - (org-attach-link-expand link) - (org-element-property :path link)))) + (path (let ((raw-path (org-element-property :path link))) (if (not (file-name-absolute-p raw-path)) raw-path (expand-file-name raw-path)))) (filetype (file-name-extension path)) @@ -2531,14 +2525,13 @@ INFO is a plist holding contextual information. See (imagep (org-export-inline-image-p link (plist-get info :latex-inline-image-rules))) (path (org-latex--protect-text - (cond ((member type '("http" "https" "ftp" "mailto" "doi")) - (concat type ":" raw-path)) - ((member type '("file" "attachment")) - (when (string= type "attachment") - (setq raw-path (org-attach-link-expand link))) - (org-export-file-uri raw-path)) - (t - raw-path))))) + (pcase type + ((or "http" "https" "ftp" "mailto" "doi") + (concat type ":" raw-path)) + ("file" + (org-export-file-uri raw-path)) + (_ + raw-path))))) (cond ;; Link type is handled by a special function. ((org-export-custom-protocol-maybe link desc 'latex info)) diff --git a/lisp/ox-man.el b/lisp/ox-man.el index 1de8d522c..0e487d896 100644 --- a/lisp/ox-man.el +++ b/lisp/ox-man.el @@ -42,8 +42,6 @@ ;;; Function Declarations -(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name)) - (defvar org-export-man-default-packages-alist) (defvar org-export-man-packages-alist) (defvar orgtbl-exp-regexp) @@ -610,17 +608,14 @@ DESC is the description part of the link, or the empty string. INFO is a plist holding contextual information. See `org-export-data'." (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) + (raw-path (org-element-property :path link)) ;; Ensure DESC really exists, or set it to nil. (desc (and (not (string= desc "")) desc)) - (path (cond - ((member type '("http" "https" "ftp" "mailto")) - (concat type ":" raw-path)) - ((member type '("file" "attachment")) - (when (string= type "attachment") - (setq raw-path (org-attach-link-expand link))) - (org-export-file-uri raw-path)) - (t raw-path)))) + (path (pcase type + ((or "http" "https" "ftp" "mailto") + (concat type ":" raw-path)) + ("file" (org-export-file-uri raw-path)) + (_ raw-path)))) (cond ;; Link type is handled by a special function. ((org-export-custom-protocol-maybe link desc 'man info)) diff --git a/lisp/ox-md.el b/lisp/ox-md.el index 1933d9e9f..f27645976 100644 --- a/lisp/ox-md.el +++ b/lisp/ox-md.el @@ -33,10 +33,6 @@ (require 'ox-publish) -;;; Function Declarations - -(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name)) - ;;; User-Configurable Variables (defgroup org-export-md nil @@ -405,9 +401,7 @@ INFO is a plist holding contextual information. See (path (cond ((member type '("http" "https" "ftp" "mailto")) (concat type ":" raw-path)) - ((member type '("file" "attachment")) - (when (string= type "attachment") - (setq raw-path (org-attach-link-expand link))) + ((string-equal type "file") (org-export-file-uri (funcall link-org-files-as-md raw-path))) (t raw-path)))) (cond @@ -449,7 +443,7 @@ INFO is a plist holding contextual information. See description (org-export-get-reference destination info)))))))) ((org-export-inline-image-p link org-html-inline-image-rules) - (let ((path (cond ((not (member type '("file" "attachment"))) + (let ((path (cond ((not (string-equal type "file")) (concat type ":" raw-path)) ((not (file-name-absolute-p raw-path)) raw-path) (t (expand-file-name raw-path)))) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index 64bb97811..2723c60c9 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -32,10 +32,6 @@ (require 'ox) (require 'table nil 'noerror) -;;; Function Declarations - -(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name)) - ;;; Define Back-End (org-export-define-backend 'odt @@ -745,8 +741,7 @@ link's path." :value-type (regexp :tag "Path"))) (defcustom org-odt-inline-image-rules - `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg"))) - ("attachment" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))) + `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))) "Rules characterizing image files that can be inlined into ODT. A rule consists in an association whose key is the type of link @@ -2706,9 +2701,7 @@ INFO is a plist holding contextual information. See (path (cond ((member type '("http" "https" "ftp" "mailto")) (concat type ":" raw-path)) - ((member type '("file" "attachment")) - (when (string= type "attachment") - (setq raw-path (org-attach-link-expand link))) + ((string= type "file") (org-export-file-uri raw-path)) (t raw-path))) ;; Convert & to & for correct XML representation diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el index 4e7b575a7..6019eb79b 100644 --- a/lisp/ox-texinfo.el +++ b/lisp/ox-texinfo.el @@ -28,10 +28,6 @@ (require 'cl-lib) (require 'ox) -;;; Function Declarations - -(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name)) - (defvar orgtbl-exp-regexp) @@ -407,8 +403,6 @@ If two strings share the same prefix (e.g. \"ISO-8859-1\" and (defconst org-texinfo-inline-image-rules (list (cons "file" - (regexp-opt '("eps" "pdf" "png" "jpg" "jpeg" "gif" "svg"))) - (cons "attachment" (regexp-opt '("eps" "pdf" "png" "jpg" "jpeg" "gif" "svg")))) "Rules characterizing image files that can be inlined.") @@ -1059,9 +1053,7 @@ INFO is a plist holding contextual information. See (path (cond ((member type '("http" "https" "ftp")) (concat type ":" raw-path)) - ((member type '("file" "attachment")) - (when (string= type "attachment") - (setq raw-path (org-attach-link-expand link))) + ((string-equal type "file") (org-export-file-uri raw-path)) (t raw-path)))) (cond -- 2.25.0