Ver Fonte

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 há 5 anos atrás
pai
commit
42ec2462a0
10 ficheiros alterados com 66 adições e 94 exclusões
  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-src-source-type "org-src" ())
 (declare-function org-time-stamp-format "org" (&optional long inactive))
 (declare-function org-time-stamp-format "org" (&optional long inactive))
 (declare-function outline-next-heading "outline" ())
 (declare-function outline-next-heading "outline" ())
-(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name))
 
 
 
 
 ;;; Customization
 ;;; Customization
@@ -1027,9 +1026,7 @@ for internal and \"file\" links, or stored as a parameter in
     (pcase type
     (pcase type
       ;; Opening a "file" link requires special treatment since we
       ;; Opening a "file" link requires special treatment since we
       ;; first need to integrate search option, if any.
       ;; 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))
        (let* ((option (org-element-property :search-option link))
 	      (path (if option (concat path "::" option) path)))
 	      (path (if option (concat path "::" option) path)))
 	 (org-link-open-as-file 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 dired-dwim-target-directory "dired-aux")
 (declare-function org-element-property "org-element" (property element))
 (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
 (defgroup org-attach nil
   "Options concerning attachments in Org mode."
   "Options concerning attachments in Org mode."
@@ -646,22 +648,36 @@ See `org-attach-open'."
 Basically, this adds the path to the attachment directory."
 Basically, this adds the path to the attachment directory."
   (expand-file-name file (org-attach-dir)))
   (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"
 (org-link-set-parameters "attachment"
+			 :follow #'org-attach-follow
+			 :export #'org-export-link-as-file
                          :complete #'org-attach-complete-link)
                          :complete #'org-attach-complete-link)
 
 
 (defun 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-archive-hook 'org-attach-archive-delete-maybe)
+(add-hook 'org-export-before-parsing-hook 'org-attach-expand-links)
 
 
 (provide 'org-attach)
 (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
 	(setq post-blank
 	      (progn (goto-char link-end) (skip-chars-forward " \t")))
 	      (progn (goto-char link-end) (skip-chars-forward " \t")))
 	(setq end (point)))
 	(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)
 	(when (string-match "::\\(.*\\)\\'" path)
 	  (setq search-option (match-string 1 path))
 	  (setq search-option (match-string 1 path))
 	  (setq path (replace-match "" nil nil path)))
 	  (setq path (replace-match "" nil nil path)))

+ 9 - 14
lisp/ox-ascii.el

@@ -34,7 +34,6 @@
 ;;; Function Declarations
 ;;; Function Declarations
 
 
 (declare-function aa2u "ext:ascii-art-to-unicode" ())
 (declare-function aa2u "ext:ascii-art-to-unicode" ())
-(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name))
 
 
 ;;; Define Back-End
 ;;; 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.
 DESC is the description part of the link, or the empty string.
 INFO is a plist holding contextual information."
 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
     (cond
      ((org-export-custom-protocol-maybe link desc 'ascii info))
      ((org-export-custom-protocol-maybe link desc 'ascii info))
      ((string= type "coderef")
      ((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
      ;; Do not apply a special syntax on radio links.  Though, use
      ;; transcoded target's contents as output.
      ;; transcoded target's contents as output.
      ((string= type "radio") desc)
      ((string= type "radio") desc)
@@ -1614,10 +1608,11 @@ INFO is a plist holding contextual information."
 	  ;; Don't know what to do.  Signal it.
 	  ;; Don't know what to do.  Signal it.
 	  (_ "???"))))
 	  (_ "???"))))
      (t
      (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
 ;;;; Node Properties

+ 1 - 5
lisp/ox-html.el

@@ -42,7 +42,6 @@
 (declare-function org-id-find-id-file "org-id" (id))
 (declare-function org-id-find-id-file "org-id" (id))
 (declare-function htmlize-region "ext:htmlize" (beg end))
 (declare-function htmlize-region "ext:htmlize" (beg end))
 (declare-function mm-url-decode-entities "mm-url" ())
 (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-css-name-prefix)
 (defvar htmlize-output-type)
 (defvar htmlize-output-type)
@@ -814,7 +813,6 @@ link to the image."
 
 
 (defcustom org-html-inline-image-rules
 (defcustom org-html-inline-image-rules
   `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))
   `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))
-    ("attachment" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))
     ("http" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))
     ("http" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))
     ("https" . ,(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.
   "Rules characterizing image files that can be inlined into HTML.
@@ -2996,9 +2994,7 @@ INFO is a plist holding contextual information.  See
 	  (cond
 	  (cond
 	   ((member type '("http" "https" "ftp" "mailto" "news"))
 	   ((member type '("http" "https" "ftp" "mailto" "news"))
 	    (url-encode-url (concat type ":" raw-path)))
 	    (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
 	    ;; During publishing, turn absolute file names belonging
 	    ;; to base directory into relative file names.  Otherwise,
 	    ;; to base directory into relative file names.  Otherwise,
 	    ;; append "file" protocol to absolute file name.
 	    ;; append "file" protocol to absolute file name.

+ 8 - 15
lisp/ox-latex.el

@@ -32,8 +32,6 @@
 
 
 ;;; Function Declarations
 ;;; Function Declarations
 
 
-(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name))
-
 (defvar org-latex-default-packages-alist)
 (defvar org-latex-default-packages-alist)
 (defvar org-latex-packages-alist)
 (defvar org-latex-packages-alist)
 (defvar orgtbl-exp-regexp)
 (defvar orgtbl-exp-regexp)
@@ -741,8 +739,6 @@ environment."
 
 
 (defcustom org-latex-inline-image-rules
 (defcustom org-latex-inline-image-rules
   `(("file" . ,(regexp-opt
   `(("file" . ,(regexp-opt
-		'("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg")))
-    ("attachment" . ,(regexp-opt
 		'("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg"))))
 		'("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg"))))
   "Rules characterizing image files that can be inlined into LaTeX.
   "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
 LINK is the link pointing to the inline image.  INFO is a plist
 used as a communication channel."
 used as a communication channel."
   (let* ((parent (org-export-get-parent-element link))
   (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
 		 (if (not (file-name-absolute-p raw-path)) raw-path
 		   (expand-file-name raw-path))))
 		   (expand-file-name raw-path))))
 	 (filetype (file-name-extension path))
 	 (filetype (file-name-extension path))
@@ -2531,14 +2525,13 @@ INFO is a plist holding contextual information.  See
 	 (imagep (org-export-inline-image-p
 	 (imagep (org-export-inline-image-p
 		  link (plist-get info :latex-inline-image-rules)))
 		  link (plist-get info :latex-inline-image-rules)))
 	 (path (org-latex--protect-text
 	 (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
     (cond
      ;; Link type is handled by a special function.
      ;; Link type is handled by a special function.
      ((org-export-custom-protocol-maybe link desc 'latex info))
      ((org-export-custom-protocol-maybe link desc 'latex info))

+ 6 - 11
lisp/ox-man.el

@@ -42,8 +42,6 @@
 
 
 ;;; Function Declarations
 ;;; 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-default-packages-alist)
 (defvar org-export-man-packages-alist)
 (defvar org-export-man-packages-alist)
 (defvar orgtbl-exp-regexp)
 (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
 INFO is a plist holding contextual information.  See
 `org-export-data'."
 `org-export-data'."
   (let* ((type (org-element-property :type link))
   (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.
          ;; Ensure DESC really exists, or set it to nil.
          (desc (and (not (string= desc "")) desc))
          (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
     (cond
      ;; Link type is handled by a special function.
      ;; Link type is handled by a special function.
      ((org-export-custom-protocol-maybe link desc 'man info))
      ((org-export-custom-protocol-maybe link desc 'man info))

+ 2 - 8
lisp/ox-md.el

@@ -33,10 +33,6 @@
 (require 'ox-publish)
 (require 'ox-publish)
 
 
 
 
-;;; Function Declarations
-
-(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name))
-
 ;;; User-Configurable Variables
 ;;; User-Configurable Variables
 
 
 (defgroup org-export-md nil
 (defgroup org-export-md nil
@@ -405,9 +401,7 @@ INFO is a plist holding contextual information.  See
 	 (path (cond
 	 (path (cond
 		((member type '("http" "https" "ftp" "mailto"))
 		((member type '("http" "https" "ftp" "mailto"))
 		 (concat type ":" raw-path))
 		 (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)))
 		 (org-export-file-uri (funcall link-org-files-as-md raw-path)))
 		(t raw-path))))
 		(t raw-path))))
     (cond
     (cond
@@ -449,7 +443,7 @@ INFO is a plist holding contextual information.  See
 		       description
 		       description
 		       (org-export-get-reference destination info))))))))
 		       (org-export-get-reference destination info))))))))
      ((org-export-inline-image-p link org-html-inline-image-rules)
      ((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))
 			 (concat type ":" raw-path))
 			((not (file-name-absolute-p raw-path)) raw-path)
 			((not (file-name-absolute-p raw-path)) raw-path)
 			(t (expand-file-name raw-path))))
 			(t (expand-file-name raw-path))))

+ 2 - 9
lisp/ox-odt.el

@@ -32,10 +32,6 @@
 (require 'ox)
 (require 'ox)
 (require 'table nil 'noerror)
 (require 'table nil 'noerror)
 
 
-;;; Function Declarations
-
-(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name))
-
 ;;; Define Back-End
 ;;; Define Back-End
 
 
 (org-export-define-backend 'odt
 (org-export-define-backend 'odt
@@ -745,8 +741,7 @@ link's path."
 		:value-type (regexp :tag "Path")))
 		:value-type (regexp :tag "Path")))
 
 
 (defcustom org-odt-inline-image-rules
 (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.
   "Rules characterizing image files that can be inlined into ODT.
 
 
 A rule consists in an association whose key is the type of link
 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
 	 (path (cond
 		((member type '("http" "https" "ftp" "mailto"))
 		((member type '("http" "https" "ftp" "mailto"))
 		 (concat type ":" raw-path))
 		 (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))
 		 (org-export-file-uri raw-path))
 		(t raw-path)))
 		(t raw-path)))
 	 ;; Convert & to &amp; for correct XML representation
 	 ;; Convert & to &amp; for correct XML representation

+ 1 - 9
lisp/ox-texinfo.el

@@ -28,10 +28,6 @@
 (require 'cl-lib)
 (require 'cl-lib)
 (require 'ox)
 (require 'ox)
 
 
-;;; Function Declarations
-
-(declare-function org-attach-link-expand "org-attach" (link &optional buffer-or-name))
-
 (defvar orgtbl-exp-regexp)
 (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
 (defconst org-texinfo-inline-image-rules
   (list (cons "file"
   (list (cons "file"
-	      (regexp-opt '("eps" "pdf" "png" "jpg" "jpeg" "gif" "svg")))
-	 (cons "attachment"
 	      (regexp-opt '("eps" "pdf" "png" "jpg" "jpeg" "gif" "svg"))))
 	      (regexp-opt '("eps" "pdf" "png" "jpg" "jpeg" "gif" "svg"))))
   "Rules characterizing image files that can be inlined.")
   "Rules characterizing image files that can be inlined.")
 
 
@@ -1059,9 +1053,7 @@ INFO is a plist holding contextual information.  See
 	 (path (cond
 	 (path (cond
 		((member type '("http" "https" "ftp"))
 		((member type '("http" "https" "ftp"))
 		 (concat type ":" raw-path))
 		 (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))
 		 (org-export-file-uri raw-path))
 		(t raw-path))))
 		(t raw-path))))
     (cond
     (cond