Procházet zdrojové kódy

Give link parser knowledge of attachment link expanded path

* lisp/org-element.el (org-element-link-parser): Add info about
  expanded attachment paths to the link parse tree export.

* lisp/org-attach.el Remove org-attach-open-link.  Let attachment
  links use the built in code that already is developed for file
  links.

* lisp/ol.el (org-link-open): Add knowledge about attachment links to
  the function opening links, so they can be opened exactly as file
  links are opened.

* lisp/ox-texinfo.el (org-texinfo-link)
* lisp/ox-odt.el (org-odt-link)
* lisp/ox-md.el (org-md-link)
* lisp/ox-man.el (org-man-link)
* lisp/ox-latex.el (org-latex--inline-image, org-latex-link)
* lisp/ox-html.el (org-html-link)
* lisp/ox-ascii.el (org-ascii-link): Refactor to use property from
  link parser instead of invoking attachment expansion in the
  exporter.
Gustav Wikström před 5 roky
rodič
revize
20d293b4aa
10 změnil soubory, kde provedl 61 přidání a 139 odebrání
  1. 3 1
      lisp/ol.el
  2. 0 21
      lisp/org-attach.el
  3. 26 16
      lisp/org-element.el
  4. 3 12
      lisp/ox-ascii.el
  5. 4 13
      lisp/ox-html.el
  6. 7 19
      lisp/ox-latex.el
  7. 4 14
      lisp/ox-man.el
  8. 6 15
      lisp/ox-md.el
  9. 4 14
      lisp/ox-odt.el
  10. 4 14
      lisp/ox-texinfo.el

+ 3 - 1
lisp/ol.el

@@ -932,7 +932,9 @@ a \"file\" link."
   (let ((type (org-element-property :type link))
 	(path (org-element-property :path link)))
     (cond
-     ((equal type "file")
+     ((member type '("file" "attachment"))
+      (when (string= type "attachment")
+	(setq path (org-element-property :attachment-path link)))
       (if (string-match "[*?{]" (file-name-nondirectory path))
 	  (dired path)
 	;; Look into `org-link-parameters' in order to find

+ 0 - 21
lisp/org-attach.el

@@ -636,29 +636,8 @@ Basically, this adds the path to the attachment directory."
   (expand-file-name file (org-attach-dir)))
 
 (org-link-set-parameters "attachment"
-                         :follow #'org-attach-open-link
                          :complete #'org-attach-complete-link)
 
-(defun org-attach-open-link (link &optional in-emacs)
-  "Attachment link type LINK is expanded with the attached directory and opened.
-
-With optional prefix argument IN-EMACS, Emacs will visit the file.
-With a double \\[universal-argument] \\[universal-argument] \
-prefix arg, Org tries to avoid opening in Emacs
-and to use an external application to visit the file."
-  (interactive "P")
-  (let (line search)
-    (cond
-     ((string-match "::\\([0-9]+\\)\\'" link)
-      (setq line (string-to-number (match-string 1 link))
-	    link (substring link 0 (match-beginning 0))))
-     ((string-match "::\\(.+\\)\\'" link)
-      (setq search (match-string 1 link)
-            link (substring link 0 (match-beginning 0)))))
-    (if (string-match "[*?{]" (file-name-nondirectory link))
-        (dired (org-attach-expand link))
-      (org-open-file (org-attach-expand link) in-emacs line search))))
-
 (defun org-attach-complete-link ()
   "Advise the user with the available files in the attachment directory."
   (let ((attach-dir (org-attach-dir)))

+ 26 - 16
lisp/org-element.el

@@ -3210,10 +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" 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) type "file")
+      ;; 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))
 	(when (string-match "::\\(.*\\)\\'" path)
 	  (setq search-option (match-string 1 path))
 	  (setq path (replace-match "" nil nil path)))
@@ -3224,18 +3225,27 @@ Assume point is at the beginning of the link."
 	(when trans
 	  (setq type (car trans))
 	  (setq path (cdr trans))))
-      (list 'link
-	    (list :type type
-		  :path path
-		  :format format
-		  :raw-link (or raw-link path)
-		  :application application
-		  :search-option search-option
-		  :begin begin
-		  :end end
-		  :contents-begin contents-begin
-		  :contents-end contents-end
-		  :post-blank post-blank)))))
+      (let ((link
+	     (list 'link
+		   (list :type type
+			 :path path
+			 :format format
+			 :raw-link (or raw-link path)
+			 :application application
+			 :search-option search-option
+			 :begin begin
+			 :end end
+			 :contents-begin contents-begin
+			 :contents-end contents-end
+			 :post-blank post-blank))))
+	;; Add additional type specific properties for link types that
+	;; need it
+	(when (string= type "attachment")
+	  (org-element-put-property
+	   link :attachment-path
+	   (file-relative-name
+	    (org-attach-expand path))))
+	link))))
 
 (defun org-element-link-interpreter (link contents)
   "Interpret LINK object as Org syntax.

+ 3 - 12
lisp/ox-ascii.el

@@ -34,7 +34,6 @@
 ;;; Function Declarations
 
 (declare-function aa2u "ext:ascii-art-to-unicode" ())
-(declare-function org-attach-expand "org-attach" (file))
 
 ;;; Define Back-End
 ;;
@@ -1570,19 +1569,11 @@ 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* ((raw-type (org-element-property :type link))
-	 (type (if (string= raw-type "attachment")
-		   ;; Attachments are simplified representations of
-		   ;; file links.  When exporting, expose attachments
-		   ;; as if they were file links.
-		   "file"
-		 raw-type))
+  (let* ((type (org-element-property :type link))
 	 (raw-path (org-element-property :path link))
 	 (path (cond
-		((string= raw-type "attachment")
-		 (setq raw-path (file-relative-name
-				 (org-with-point-at (org-element-property :begin link)
-				   (org-attach-expand raw-path))))
+		((string= type "attachment")
+		 (setq raw-path (org-element-property :attachment-path link))
 		 (concat type ":" raw-path))
 		(t (concat type ":" raw-path)))))
     (cond

+ 4 - 13
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-expand "org-attach" (file))
 
 (defvar htmlize-css-name-prefix)
 (defvar htmlize-output-type)
@@ -3065,13 +3064,7 @@ INFO is a plist holding contextual information.  See
 	      (concat (file-name-sans-extension raw-path) "."
 		      (plist-get info :html-extension)))
 	     (t raw-path))))
-	 (raw-type (org-element-property :type link))
-	 (type (if (string= raw-type "attachment")
-		   ;; Attachments are simplified representations of
-		   ;; file links.  When exporting, expose attachments
-		   ;; as if they were file links.
-		   "file"
-		 raw-type))
+	 (type (org-element-property :type link))
 	 (raw-path (org-element-property :path link))
 	 ;; Ensure DESC really exists, or set it to nil.
 	 (desc (org-string-nw-p desc))
@@ -3079,11 +3072,9 @@ INFO is a plist holding contextual information.  See
 	  (cond
 	   ((member type '("http" "https" "ftp" "mailto" "news"))
 	    (url-encode-url (concat type ":" raw-path)))
-	   ((string= type "file")
-	    (when (string= raw-type "attachment")
-	      (setq raw-path (file-relative-name
-			      (org-with-point-at (org-element-property :begin link)
-				(org-attach-expand raw-path)))))
+	   ((member type '("file" "attachment"))
+	    (when (string= type "attachment")
+	      (setq raw-path (org-element-property :attachment-path link)))
 	    ;; During publishing, turn absolute file names belonging
 	    ;; to base directory into relative file names.  Otherwise,
 	    ;; append "file" protocol to absolute file name.

+ 7 - 19
lisp/ox-latex.el

@@ -32,8 +32,6 @@
 
 ;;; Function Declarations
 
-(declare-function org-attach-expand "org-attach" (file))
-
 (defvar org-latex-default-packages-alist)
 (defvar org-latex-packages-alist)
 (defvar orgtbl-exp-regexp)
@@ -2361,11 +2359,9 @@ 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 (org-element-property :path link)))
-		 (when (string= (org-element-property :type link) "attachment")
-		   (setq raw-path (file-relative-name
-				   (org-with-point-at (org-element-property :begin link)
-				     (org-attach-expand raw-path)))))
+	 (path (let ((raw-path (if (string= (org-element-property :type link) "attachment")
+				   (org-element-property :attachment-path link)
+				 (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))
@@ -2521,13 +2517,7 @@ used as a communication channel."
 DESC is the description part of the link, or the empty string.
 INFO is a plist holding contextual information.  See
 `org-export-data'."
-  (let* ((raw-type (org-element-property :type link))
-	 (type (if (string= raw-type "attachment")
-		   ;; Attachments are simplified representations of
-		   ;; file links.  When exporting, expose attachments
-		   ;; as if they were file links.
-		   "file"
-		 raw-type))
+  (let* ((type (org-element-property :type link))
 	 (raw-path (org-element-property :path link))
 	 ;; Ensure DESC really exists, or set it to nil.
 	 (desc (and (not (string= desc "")) desc))
@@ -2536,11 +2526,9 @@ INFO is a plist holding contextual information.  See
 	 (path (org-latex--protect-text
 		(cond ((member type '("http" "https" "ftp" "mailto" "doi"))
 		       (concat type ":" raw-path))
-		      ((string= type "file")
-		       (when (string= raw-type "attachment")
-			 (setq raw-path (file-relative-name
-					 (org-with-point-at (org-element-property :begin link)
-					   (org-attach-expand raw-path)))))
+		      ((member type '("file" "attachment"))
+		       (when (string= type "attachment")
+			 (setq raw-path (org-element-property :attachment-path link)))
 		       (org-export-file-uri raw-path))
 		      (t
 		       raw-path)))))

+ 4 - 14
lisp/ox-man.el

@@ -42,8 +42,6 @@
 
 ;;; Function Declarations
 
-(declare-function org-attach-expand "org-attach" (file))
-
 (defvar org-export-man-default-packages-alist)
 (defvar org-export-man-packages-alist)
 (defvar orgtbl-exp-regexp)
@@ -609,24 +607,16 @@ CONTENTS is nil.  INFO is a plist holding contextual information."
 DESC is the description part of the link, or the empty string.
 INFO is a plist holding contextual information.  See
 `org-export-data'."
-  (let* ((raw-type (org-element-property :type link))
-	 (type (if (string= raw-type "attachment")
-		   ;; Attachments are simplified representations of
-		   ;; file links.  When exporting, expose attachments
-		   ;; as if they were file links.
-		   "file"
-		 raw-type))
+  (let* ((type (org-element-property :type 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))
-                ((string= type "file")
-		 (when (string= raw-type "attachment")
-		   (setq raw-path (file-relative-name
-				   (org-with-point-at (org-element-property :begin link)
-				     (org-attach-expand raw-path)))))
+                ((member type '("file" "attachment"))
+		 (when (string= type "attachment")
+		   (setq raw-path (org-element-property :attachment-path link)))
 		 (org-export-file-uri raw-path))
                 (t raw-path))))
     (cond

+ 6 - 15
lisp/ox-md.el

@@ -35,8 +35,6 @@
 
 ;;; Function Declarations
 
-(declare-function org-attach-expand "org-attach" (file))
-
 ;;; User-Configurable Variables
 
 (defgroup org-export-md nil
@@ -400,22 +398,14 @@ INFO is a plist holding contextual information.  See
 	    (if (string= ".org" (downcase (file-name-extension raw-path ".")))
 		(concat (file-name-sans-extension raw-path) ".md")
 	      raw-path)))
-	 (raw-type (org-element-property :type link))
-	 (type (if (string= raw-type "attachment")
-		   ;; Attachments are simplified representations of
-		   ;; file links.  When exporting, expose attachments
-		   ;; as if they were file links.
-		   "file"
-		 raw-type))
+	 (type (org-element-property :type link))
 	 (raw-path (org-element-property :path link))
 	 (path (cond
 		((member type '("http" "https" "ftp" "mailto"))
 		 (concat type ":" raw-path))
-		((string= type "file")
-		 (when (string= raw-type "attachment")
-		   (setq raw-path (file-relative-name
-				   (org-with-point-at (org-element-property :begin link)
-				     (org-attach-expand raw-path)))))
+		((member type '("file" "attachment"))
+		 (when (string= type "attachment")
+		   (setq raw-path (org-element-property :attachment-path link)))
 		 (org-export-file-uri (funcall link-org-files-as-md raw-path)))
 		(t raw-path))))
     (cond
@@ -457,7 +447,8 @@ 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 (equal "file" type)) (concat type ":" raw-path))
+      (let ((path (cond ((not (member type '("file" "attachment")))
+			 (concat type ":" raw-path))
 			((not (file-name-absolute-p raw-path)) raw-path)
 			(t (expand-file-name raw-path))))
 	    (caption (org-export-data

+ 4 - 14
lisp/ox-odt.el

@@ -34,8 +34,6 @@
 
 ;;; Function Declarations
 
-(declare-function org-attach-expand "org-attach" (file))
-
 ;;; Define Back-End
 
 (org-export-define-backend 'odt
@@ -2697,13 +2695,7 @@ Return nil, otherwise."
 DESC is the description part of the link, or the empty string.
 INFO is a plist holding contextual information.  See
 `org-export-data'."
-  (let* ((raw-type (org-element-property :type link))
-	 (type (if (string= raw-type "attachment")
-		   ;; Attachments are simplified representations of
-		   ;; file links.  When exporting, expose attachments
-		   ;; as if they were file links.
-		   "file"
-		 raw-type))
+  (let* ((type (org-element-property :type link))
 	 (raw-path (org-element-property :path link))
 	 ;; Ensure DESC really exists, or set it to nil.
 	 (desc (and (not (string= desc "")) desc))
@@ -2712,11 +2704,9 @@ INFO is a plist holding contextual information.  See
 	 (path (cond
 		((member type '("http" "https" "ftp" "mailto"))
 		 (concat type ":" raw-path))
-		((string= type "file")
-		 (when (string= raw-type "attachment")
-		   (setq raw-path (file-relative-name
-				   (org-with-point-at (org-element-property :begin link)
-				     (org-attach-expand raw-path)))))
+		((member type '("file" "attachment"))
+		 (when (string= type "attachment")
+		   (setq raw-path (org-element-property :attachment-path link)))
 		 (org-export-file-uri raw-path))
 		(t raw-path)))
 	 ;; Convert & to & for correct XML representation

+ 4 - 14
lisp/ox-texinfo.el

@@ -30,8 +30,6 @@
 
 ;;; Function Declarations
 
-(declare-function org-attach-expand "org-attach" (file))
-
 (defvar orgtbl-exp-regexp)
 
 
@@ -1051,24 +1049,16 @@ nil."
 DESC is the description part of the link, or the empty string.
 INFO is a plist holding contextual information.  See
 `org-export-data'."
-  (let* ((raw-type (org-element-property :type link))
-	 (type (if (string= raw-type "attachment")
-		   ;; Attachments are simplified representations of
-		   ;; file links.  When exporting, expose attachments
-		   ;; as if they were file links.
-		   "file"
-		 raw-type))
+  (let* ((type (org-element-property :type 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"))
 		 (concat type ":" raw-path))
-		((string= type "file")
-		 (when (string= raw-type "attachment")
-		   (setq raw-path (file-relative-name
-				   (org-with-point-at (org-element-property :begin link)
-				(org-attach-expand raw-path)))))
+		((member type '("file" "attachment"))
+		 (when (string= type "attachment")
+		   (setq raw-path (org-element-property :attachment-path link)))
 		 (org-export-file-uri raw-path))
 		(t raw-path))))
     (cond