diff --git a/contrib/lisp/ox-groff.el b/contrib/lisp/ox-groff.el
index d8baf391c..b618395cb 100644
--- a/contrib/lisp/ox-groff.el
+++ b/contrib/lisp/ox-groff.el
@@ -1255,9 +1255,9 @@ INFO is a plist holding contextual information. See
(concat type ":" raw-path))
((and (string= type "file") (file-name-absolute-p raw-path))
(concat "file://" raw-path))
- (t raw-path)))
- protocol)
+ (t raw-path))))
(cond
+ ((org-export-custom-protocol-maybe link desc info))
;; Image file.
(imagep (org-groff-link--inline-image link info))
;; import groff files
diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el
index f98564807..5da956ad0 100644
--- a/lisp/ox-ascii.el
+++ b/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."
(let ((type (org-element-property :type link)))
(cond
+ ((org-export-custom-protocol-maybe link desc info))
((string= type "coderef")
(let ((ref (org-element-property :path link)))
(format (org-export-get-coderef-format ref desc)
@@ -1545,10 +1546,6 @@ INFO is a plist holding contextual information."
(org-export-data
(org-element-property :title destination)
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
(let ((raw-link (org-element-property :raw-link link)))
(if (not (org-string-nw-p desc)) (format "[%s]" raw-link)
diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el
index 72f62155e..f53b35972 100644
--- a/lisp/ox-beamer.el
+++ b/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."
(let ((type (org-element-property :type link))
(path (org-element-property :path link)))
- ;; Use \hyperlink command for all internal links.
(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")
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) contents
diff --git a/lisp/ox-html.el b/lisp/ox-html.el
index 82073dd69..3c3b44453 100644
--- a/lisp/ox-html.el
+++ b/lisp/ox-html.el
@@ -2765,9 +2765,10 @@ INFO is a plist holding contextual information. See
(org-export-read-attribute :attr_html parent))))
(attributes
(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
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link desc info))
;; Image file.
((and (plist-get info :html-inline-images)
(org-export-inline-image-p
@@ -2856,9 +2857,6 @@ INFO is a plist holding contextual information. See
attributes
(format (org-export-get-coderef-format path desc)
(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.
((and path desc) (format "%s" path attributes desc))
;; External link without a description part.
diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el
index fb9875255..4d1edca68 100644
--- a/lisp/ox-latex.el
+++ b/lisp/ox-latex.el
@@ -1965,9 +1965,10 @@ INFO is a plist holding contextual information. See
(concat type ":" raw-path))
((and (string= type "file") (file-name-absolute-p raw-path))
(concat "file:" raw-path))
- (t raw-path)))
- protocol)
+ (t raw-path))))
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link desc info))
;; Image file.
(imagep (org-latex--inline-image link info))
;; 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")
(format (org-export-get-coderef-format path desc)
(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.
((and path desc) (format "\\href{%s}{%s}" path desc))
;; External link without a description part.
diff --git a/lisp/ox-man.el b/lisp/ox-man.el
index 9bbc52d43..4f3991bd6 100644
--- a/lisp/ox-man.el
+++ b/lisp/ox-man.el
@@ -657,6 +657,8 @@ INFO is a plist holding contextual information. See
(t raw-path)))
protocol)
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link desc info))
;; External link with a description part.
((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
;; External link without a description part.
diff --git a/lisp/ox-md.el b/lisp/ox-md.el
index c3efbca7c..809ffd6b8 100644
--- a/lisp/ox-md.el
+++ b/lisp/ox-md.el
@@ -313,6 +313,8 @@ a communication channel."
raw-path))))
(type (org-element-property :type link)))
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link contents info))
((member type '("custom-id" "id"))
(let ((destination (org-export-resolve-id-link link info)))
(if (stringp destination) ; External file.
@@ -358,13 +360,6 @@ a communication channel."
;; BUG: shouldn't headlines have a form like [ref](name) in md?
(org-export-data
(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))
(path
(cond
diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el
index 062b721d9..e96bc1d64 100644
--- a/lisp/ox-odt.el
+++ b/lisp/ox-odt.el
@@ -2736,9 +2736,10 @@ INFO is a plist holding contextual information. See
(concat "file:" raw-path))
(t raw-path)))
;; Convert & to & for correct XML representation
- (path (replace-regexp-in-string "&" "&" path))
- protocol)
+ (path (replace-regexp-in-string "&" "&" path)))
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link desc info))
;; Image file.
((and (not desc) (org-export-inline-image-p
link (plist-get info :odt-inline-image-rules)))
@@ -2820,9 +2821,6 @@ INFO is a plist holding contextual information. See
(format
"%s"
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.
((and path desc)
(let ((link-contents (org-element-contents link)))
diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el
index 49bc1dcb6..0e330080a 100644
--- a/lisp/ox-texinfo.el
+++ b/lisp/ox-texinfo.el
@@ -915,9 +915,9 @@ INFO is a plist holding contextual information. See
(concat type ":" raw-path))
((and (string= type "file") (file-name-absolute-p raw-path))
(concat "file:" raw-path))
- (t raw-path)))
- protocol)
+ (t raw-path))))
(cond
+ ((org-export-custom-protocol-maybe link desc info))
((equal type "radio")
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) desc
@@ -976,9 +976,6 @@ INFO is a plist holding contextual information. See
(format "@email{%s}"
(concat (org-texinfo--sanitize-content path)
(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.
((and path desc) (format "@uref{%s,%s}" path desc))
;; External link without a description part.
diff --git a/lisp/ox.el b/lisp/ox.el
index 5a62cee4d..85a2ff00b 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -3862,6 +3862,9 @@ meant to be translated with `org-export-data' or alike."
;;;; 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
;; 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
(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)
"Return format string for code reference link.
PATH is the link path. DESC is its description."
diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el
index 8447875bd..290b02980 100644
--- a/testing/lisp/test-ox.el
+++ b/testing/lisp/test-ox.el
@@ -2026,6 +2026,53 @@ Paragraph[fn:1]"
;;; 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 ()
"Test `org-export-get-coderef-format' specifications."
;; A link without description returns "%s"