From 39001557880e92f6a73fb4378544a25ee4beece5 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 4 Jan 2015 21:54:41 +0100 Subject: [PATCH] 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. --- contrib/lisp/ox-groff.el | 4 ++-- lisp/ox-ascii.el | 5 +---- lisp/ox-beamer.el | 4 +++- lisp/ox-html.el | 8 +++---- lisp/ox-latex.el | 8 +++---- lisp/ox-man.el | 2 ++ lisp/ox-md.el | 9 ++------ lisp/ox-odt.el | 8 +++---- lisp/ox-texinfo.el | 7 ++---- lisp/ox.el | 25 +++++++++++++++++++++ testing/lisp/test-ox.el | 47 ++++++++++++++++++++++++++++++++++++++++ 11 files changed, 93 insertions(+), 34 deletions(-) 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"