Browse Source

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.
Nicolas Goaziou 5 years ago
parent
commit
42ec2462a0
10 changed files with 66 additions and 94 deletions
  1. 1 4
      lisp/ol.el
  2. 31 14
      lisp/org-attach.el
  3. 5 5
      lisp/org-element.el
  4. 9 14
      lisp/ox-ascii.el
  5. 1 5
      lisp/ox-html.el
  6. 8 15
      lisp/ox-latex.el
  7. 6 11
      lisp/ox-man.el
  8. 2 8
      lisp/ox-md.el
  9. 2 9
      lisp/ox-odt.el
  10. 1 9
      lisp/ox-texinfo.el

+ 1 - 4
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

+ 31 - 14
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)
 

+ 5 - 5
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)))

+ 9 - 14
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

+ 1 - 5
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.

+ 8 - 15
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))

+ 6 - 11
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))

+ 2 - 8
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))))

+ 2 - 9
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 &amp; for correct XML representation

+ 1 - 9
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