Browse Source

Implement `org-export-custom-protocol-maybe' and use it

* lisp/ox.el (org-export-custom-protocol-maybe): New function.
* contrib/lisp/ox-groff.el (org-groff-link):
* lisp/ox-ascii.el (org-ascii-link):
* lisp/ox-beamer.el (org-beamer-link):
* lisp/ox-html.el (org-html-link):
* lisp/ox-latex.el (org-latex-link):
* lisp/ox-man.el (org-man-link):
* lisp/ox-md.el (org-md-link):
* lisp/ox-odt.el (org-odt-link):
* lisp/ox-texinfo.el (org-texinfo-link): Use new function.

* testing/lisp/test-ox.el (test-org-export/custom-protocol-maybe): New
  test.
Nicolas Goaziou 10 years ago
parent
commit
3900155788
11 changed files with 93 additions and 34 deletions
  1. 2 2
      contrib/lisp/ox-groff.el
  2. 1 4
      lisp/ox-ascii.el
  3. 3 1
      lisp/ox-beamer.el
  4. 3 5
      lisp/ox-html.el
  5. 3 5
      lisp/ox-latex.el
  6. 2 0
      lisp/ox-man.el
  7. 2 7
      lisp/ox-md.el
  8. 3 5
      lisp/ox-odt.el
  9. 2 5
      lisp/ox-texinfo.el
  10. 25 0
      lisp/ox.el
  11. 47 0
      testing/lisp/test-ox.el

+ 2 - 2
contrib/lisp/ox-groff.el

@@ -1255,9 +1255,9 @@ INFO is a plist holding contextual information.  See
                  (concat type ":" raw-path))
                  (concat type ":" raw-path))
                 ((and (string= type "file") (file-name-absolute-p raw-path))
                 ((and (string= type "file") (file-name-absolute-p raw-path))
                  (concat "file://" raw-path))
                  (concat "file://" raw-path))
-                (t raw-path)))
-         protocol)
+                (t raw-path))))
     (cond
     (cond
+     ((org-export-custom-protocol-maybe link desc info))
      ;; Image file.
      ;; Image file.
      (imagep (org-groff-link--inline-image link info))
      (imagep (org-groff-link--inline-image link info))
      ;; import groff files
      ;; import groff files

+ 1 - 4
lisp/ox-ascii.el

@@ -1520,6 +1520,7 @@ 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)))
   (let ((type (org-element-property :type link)))
     (cond
     (cond
+     ((org-export-custom-protocol-maybe link desc info))
      ((string= type "coderef")
      ((string= type "coderef")
       (let ((ref (org-element-property :path link)))
       (let ((ref (org-element-property :path link)))
 	(format (org-export-get-coderef-format ref desc)
 	(format (org-export-get-coderef-format ref desc)
@@ -1545,10 +1546,6 @@ INFO is a plist holding contextual information."
 			  (org-export-data
 			  (org-export-data
 			   (org-element-property :title destination)
 			   (org-element-property :title destination)
 			   info)))))))))
 			   info)))))))))
-     ((let ((protocol (nth 2 (assoc type org-link-protocols)))
-	    (path (org-element-property :path link)))
-	(and (functionp protocol)
-	     (funcall protocol (org-link-unescape path) desc 'ascii))))
      (t
      (t
       (let ((raw-link (org-element-property :raw-link link)))
       (let ((raw-link (org-element-property :raw-link link)))
 	(if (not (org-string-nw-p desc)) (format "[%s]" raw-link)
 	(if (not (org-string-nw-p desc)) (format "[%s]" raw-link)

+ 3 - 1
lisp/ox-beamer.el

@@ -689,8 +689,10 @@ CONTENTS is the description part of the link.  INFO is a plist
 used as a communication channel."
 used as a communication channel."
   (let ((type (org-element-property :type link))
   (let ((type (org-element-property :type link))
 	(path (org-element-property :path link)))
 	(path (org-element-property :path link)))
-    ;; Use \hyperlink command for all internal links.
     (cond
     (cond
+     ;; Link type is handled by a special function.
+     ((org-export-custom-protocol-maybe link contents info))
+     ;; Use \hyperlink command for all internal links.
      ((equal type "radio")
      ((equal type "radio")
       (let ((destination (org-export-resolve-radio-link link info)))
       (let ((destination (org-export-resolve-radio-link link info)))
 	(if (not destination) contents
 	(if (not destination) contents

+ 3 - 5
lisp/ox-html.el

@@ -2765,9 +2765,10 @@ INFO is a plist holding contextual information.  See
 		 (org-export-read-attribute :attr_html parent))))
 		 (org-export-read-attribute :attr_html parent))))
 	 (attributes
 	 (attributes
 	  (let ((attr (org-html--make-attribute-string attributes-plist)))
 	  (let ((attr (org-html--make-attribute-string attributes-plist)))
-	    (if (org-string-nw-p attr) (concat " " attr) "")))
-	 protocol)
+	    (if (org-string-nw-p attr) (concat " " attr) ""))))
     (cond
     (cond
+     ;; Link type is handled by a special function.
+     ((org-export-custom-protocol-maybe link desc info))
      ;; Image file.
      ;; Image file.
      ((and (plist-get info :html-inline-images)
      ((and (plist-get info :html-inline-images)
 	   (org-export-inline-image-p
 	   (org-export-inline-image-p
@@ -2856,9 +2857,6 @@ INFO is a plist holding contextual information.  See
 		attributes
 		attributes
 		(format (org-export-get-coderef-format path desc)
 		(format (org-export-get-coderef-format path desc)
 			(org-export-resolve-coderef path info)))))
 			(org-export-resolve-coderef path info)))))
-     ;; Link type is handled by a special function.
-     ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
-      (funcall protocol (org-link-unescape path) desc 'html))
      ;; External link with a description part.
      ;; External link with a description part.
      ((and path desc) (format "<a href=\"%s\"%s>%s</a>" path attributes desc))
      ((and path desc) (format "<a href=\"%s\"%s>%s</a>" path attributes desc))
      ;; External link without a description part.
      ;; External link without a description part.

+ 3 - 5
lisp/ox-latex.el

@@ -1965,9 +1965,10 @@ INFO is a plist holding contextual information.  See
 		 (concat type ":" raw-path))
 		 (concat type ":" raw-path))
 		((and (string= type "file") (file-name-absolute-p raw-path))
 		((and (string= type "file") (file-name-absolute-p raw-path))
 		 (concat "file:" raw-path))
 		 (concat "file:" raw-path))
-		(t raw-path)))
-	 protocol)
+		(t raw-path))))
     (cond
     (cond
+     ;; Link type is handled by a special function.
+     ((org-export-custom-protocol-maybe link desc info))
      ;; Image file.
      ;; Image file.
      (imagep (org-latex--inline-image link info))
      (imagep (org-latex--inline-image link info))
      ;; Radio link: Transcode target's contents and use them as link's
      ;; Radio link: Transcode target's contents and use them as link's
@@ -2023,9 +2024,6 @@ INFO is a plist holding contextual information.  See
      ((string= type "coderef")
      ((string= type "coderef")
       (format (org-export-get-coderef-format path desc)
       (format (org-export-get-coderef-format path desc)
 	      (org-export-resolve-coderef path info)))
 	      (org-export-resolve-coderef path info)))
-     ;; Link type is handled by a special function.
-     ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
-      (funcall protocol (org-link-unescape path) desc 'latex))
      ;; External link with a description part.
      ;; External link with a description part.
      ((and path desc) (format "\\href{%s}{%s}" path desc))
      ((and path desc) (format "\\href{%s}{%s}" path desc))
      ;; External link without a description part.
      ;; External link without a description part.

+ 2 - 0
lisp/ox-man.el

@@ -657,6 +657,8 @@ INFO is a plist holding contextual information.  See
                 (t raw-path)))
                 (t raw-path)))
          protocol)
          protocol)
     (cond
     (cond
+     ;; Link type is handled by a special function.
+     ((org-export-custom-protocol-maybe link desc info))
      ;; External link with a description part.
      ;; External link with a description part.
      ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
      ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
      ;; External link without a description part.
      ;; External link without a description part.

+ 2 - 7
lisp/ox-md.el

@@ -313,6 +313,8 @@ a communication channel."
 	      raw-path))))
 	      raw-path))))
 	(type (org-element-property :type link)))
 	(type (org-element-property :type link)))
     (cond
     (cond
+     ;; Link type is handled by a special function.
+     ((org-export-custom-protocol-maybe link contents info))
      ((member type '("custom-id" "id"))
      ((member type '("custom-id" "id"))
       (let ((destination (org-export-resolve-id-link link info)))
       (let ((destination (org-export-resolve-id-link link info)))
 	(if (stringp destination)	; External file.
 	(if (stringp destination)	; External file.
@@ -358,13 +360,6 @@ a communication channel."
 		     ;; BUG: shouldn't headlines have a form like [ref](name) in md?
 		     ;; BUG: shouldn't headlines have a form like [ref](name) in md?
 		     (org-export-data
 		     (org-export-data
 		      (org-element-property :title destination) info))))))))
 		      (org-element-property :title destination) info))))))))
-     ;; Link type is handled by a special function.
-     ((let ((protocol (nth 2 (assoc type org-link-protocols))))
-	(and (functionp protocol)
-	     (funcall protocol
-		      (org-link-unescape (org-element-property :path link))
-		      contents
-		      'md))))
      (t (let* ((raw-path (org-element-property :path link))
      (t (let* ((raw-path (org-element-property :path link))
 	       (path
 	       (path
 		(cond
 		(cond

+ 3 - 5
lisp/ox-odt.el

@@ -2736,9 +2736,10 @@ INFO is a plist holding contextual information.  See
 		 (concat "file:" raw-path))
 		 (concat "file:" raw-path))
 		(t raw-path)))
 		(t raw-path)))
 	 ;; Convert & to &amp; for correct XML representation
 	 ;; Convert & to &amp; for correct XML representation
-	 (path (replace-regexp-in-string "&" "&amp;" path))
-	 protocol)
+	 (path (replace-regexp-in-string "&" "&amp;" path)))
     (cond
     (cond
+     ;; Link type is handled by a special function.
+     ((org-export-custom-protocol-maybe link desc info))
      ;; Image file.
      ;; Image file.
      ((and (not desc) (org-export-inline-image-p
      ((and (not desc) (org-export-inline-image-p
 		       link (plist-get info :odt-inline-image-rules)))
 		       link (plist-get info :odt-inline-image-rules)))
@@ -2820,9 +2821,6 @@ INFO is a plist holding contextual information.  See
 	 (format
 	 (format
 	  "<text:bookmark-ref text:reference-format=\"number\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
 	  "<text:bookmark-ref text:reference-format=\"number\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
 	  href line-no))))
 	  href line-no))))
-     ;; Link type is handled by a special function.
-     ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
-      (funcall protocol (org-link-unescape path) desc 'odt))
      ;; External link with a description part.
      ;; External link with a description part.
      ((and path desc)
      ((and path desc)
       (let ((link-contents (org-element-contents link)))
       (let ((link-contents (org-element-contents link)))

+ 2 - 5
lisp/ox-texinfo.el

@@ -915,9 +915,9 @@ INFO is a plist holding contextual information.  See
 		 (concat type ":" raw-path))
 		 (concat type ":" raw-path))
 		((and (string= type "file") (file-name-absolute-p raw-path))
 		((and (string= type "file") (file-name-absolute-p raw-path))
 		 (concat "file:" raw-path))
 		 (concat "file:" raw-path))
-		(t raw-path)))
-	 protocol)
+		(t raw-path))))
     (cond
     (cond
+     ((org-export-custom-protocol-maybe link desc info))
      ((equal type "radio")
      ((equal type "radio")
       (let ((destination (org-export-resolve-radio-link link info)))
       (let ((destination (org-export-resolve-radio-link link info)))
 	(if (not destination) desc
 	(if (not destination) desc
@@ -976,9 +976,6 @@ INFO is a plist holding contextual information.  See
       (format "@email{%s}"
       (format "@email{%s}"
 	      (concat (org-texinfo--sanitize-content path)
 	      (concat (org-texinfo--sanitize-content path)
 		      (and desc (concat "," desc)))))
 		      (and desc (concat "," desc)))))
-     ((let ((protocol (nth 2 (assoc type org-link-protocols))))
-	(and (functionp protocol)
-	     (funcall protocol (org-link-unescape path) desc 'texinfo))))
      ;; External link with a description part.
      ;; External link with a description part.
      ((and path desc) (format "@uref{%s,%s}" path desc))
      ((and path desc) (format "@uref{%s,%s}" path desc))
      ;; External link without a description part.
      ;; External link without a description part.

+ 25 - 0
lisp/ox.el

@@ -3862,6 +3862,9 @@ meant to be translated with `org-export-data' or alike."
 
 
 ;;;; For Links
 ;;;; For Links
 ;;
 ;;
+;; `org-export-custom-protocol-maybe' handles custom protocol defined
+;; with `org-add-link-type', which see.
+;;
 ;; `org-export-solidify-link-text' turns a string into a safer version
 ;; `org-export-solidify-link-text' turns a string into a safer version
 ;; for links, replacing most non-standard characters with hyphens.
 ;; for links, replacing most non-standard characters with hyphens.
 ;;
 ;;
@@ -3888,6 +3891,28 @@ meant to be translated with `org-export-data' or alike."
   (save-match-data
   (save-match-data
     (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-:]+") "-")))
     (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-:]+") "-")))
 
 
+(defun org-export-custom-protocol-maybe (link desc info)
+  "Try exporting LINK with a dedicated function.
+
+DESC is its description, as a string, or nil.  INFO is the plist
+containing export state.  Return output as a string, or nil if no
+protocol handles LINK.
+
+A custom protocol is expected to have precedence over regular
+back-end export.  The function ignores links with an implicit
+type (e.g., \"custom-id\")."
+  (let ((type (org-element-property :type link))
+	(backend (let ((b (plist-get info :back-end)))
+		   (and b (org-export-backend-name b)))))
+    (unless (or (member type '("coderef" "custom-id" "fuzzy" "radio"))
+		(not backend))
+      (let ((protocol (nth 2 (assoc type org-link-protocols))))
+	(and (functionp protocol)
+	     (funcall protocol
+		      (org-link-unescape (org-element-property :path link))
+		      desc
+		      backend))))))
+
 (defun org-export-get-coderef-format (path desc)
 (defun org-export-get-coderef-format (path desc)
   "Return format string for code reference link.
   "Return format string for code reference link.
 PATH is the link path.  DESC is its description."
 PATH is the link path.  DESC is its description."

+ 47 - 0
testing/lisp/test-ox.el

@@ -2026,6 +2026,53 @@ Paragraph[fn:1]"
 
 
 ;;; Links
 ;;; Links
 
 
+(ert-deftest test-org-export/custom-protocol-maybe ()
+  "Test `org-export-custom-protocol-maybe' specifications."
+  (should
+   (string-match
+    "success"
+    (let ((org-link-types (copy-sequence org-link-types)))
+      (org-add-link-type "foo" nil (lambda (p d f) "success"))
+      (org-export-string-as
+       "[[foo:path]]"
+       (org-export-create-backend
+	:name 'test
+	:transcoders '((section . (lambda (s c i) c))
+		       (paragraph . (lambda (p c i) c))
+		       (link . (lambda (l c i)
+				 (or (org-export-custom-protocol-maybe l c i)
+				     "failure")))))))))
+  (should-not
+   (string-match
+    "success"
+    (let ((org-link-types (copy-sequence org-link-types)))
+      (org-add-link-type
+       "foo" nil (lambda (p d f) (and (eq f 'test) "success")))
+      (org-export-string-as
+       "[[foo:path]]"
+       (org-export-create-backend
+	:name 'no-test
+	:transcoders '((section . (lambda (s c i) c))
+		       (paragraph . (lambda (p c i) c))
+		       (link . (lambda (l c i)
+				 (or (org-export-custom-protocol-maybe l c i)
+				     "failure")))))))))
+  ;; Ignore anonymous back-ends.
+  (should-not
+   (string-match
+    "success"
+    (let ((org-link-types (copy-sequence org-link-types)))
+      (org-add-link-type
+       "foo" nil (lambda (p d f) (and (eq f 'test) "success")))
+      (org-export-string-as
+       "[[foo:path]]"
+       (org-export-create-backend
+	:transcoders '((section . (lambda (s c i) c))
+		       (paragraph . (lambda (p c i) c))
+		       (link . (lambda (l c i)
+				 (or (org-export-custom-protocol-maybe l c i)
+				     "failure"))))))))))
+
 (ert-deftest test-org-export/get-coderef-format ()
 (ert-deftest test-org-export/get-coderef-format ()
   "Test `org-export-get-coderef-format' specifications."
   "Test `org-export-get-coderef-format' specifications."
   ;; A link without description returns "%s"
   ;; A link without description returns "%s"