diff --git a/lisp/org-element.el b/lisp/org-element.el index eace06708..3edcfe5e6 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -3033,11 +3033,10 @@ Assume point is at the beginning of the link." ;; (e.g., insert [[shell:ls%20*.org]] instead of ;; [[shell:ls *.org]], which defeats Org's focus on ;; simplicity. - (setq raw-link (org-translate-link - (org-link-expand-abbrev - (replace-regexp-in-string - "[ \t]*\n[ \t]*" " " - (org-match-string-no-properties 1))))) + (setq raw-link (org-link-expand-abbrev + (replace-regexp-in-string + "[ \t]*\n[ \t]*" " " + (org-match-string-no-properties 1)))) ;; Determine TYPE of link and set PATH accordingly. According ;; to RFC 3986, remove whitespaces from URI in external links. ;; In internal ones, treat indentation as a single space. @@ -3090,36 +3089,51 @@ Assume point is at the beginning of the link." ;; In any case, deduce end point after trailing white space from ;; LINK-END variable. (save-excursion - (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t")) - 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") - (when (string-match "::\\(.*\\)\\'" path) - (setq search-option (match-string 1 path) - path (replace-match "" nil nil path))) - (setq path (replace-regexp-in-string "\\`/+" "/" path))) - (list 'link - (list :type type - :path path - :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)))))) + (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") + (when (string-match "::\\(.*\\)\\'" path) + (setq search-option (match-string 1 path)) + (setq path (replace-match "" nil nil path))) + (setq path (replace-regexp-in-string "\\`/+" "/" path))) + ;; Translate link, if `org-link-translation-function' is set. + (let ((trans (and (functionp org-link-translation-function) + (funcall org-link-translation-function type path)))) + (setq type (car trans)) + (setq path (cdr trans))) + (list 'link + (list :type type + :path path + :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))))) (defun org-element-link-interpreter (link contents) "Interpret LINK object as Org syntax. CONTENTS is the contents of the object, or nil." (let ((type (org-element-property :type link)) - (raw-link (org-element-property :raw-link link))) - (if (string= type "radio") raw-link + (path (org-element-property :path link))) + (if (string= type "radio") path (format "[[%s]%s]" - raw-link + (cond ((string= type "coderef") (format "(%s)" path)) + ((string= type "custom-id") (concat "#" path)) + ((string= type "file") + (let ((app (org-element-property :application link)) + (opt (org-element-property :search-option link))) + (concat type (and app (concat "+" app)) ":" + path + (and opt (concat "::" opt))))) + ((string= type "fuzzy") path) + (t (concat type ":" path))) (if contents (format "[%s]" contents) ""))))) diff --git a/lisp/org.el b/lisp/org.el index 7ab4eccf5..89b7d8263 100755 --- a/lisp/org.el +++ b/lisp/org.el @@ -10561,14 +10561,9 @@ If the link is in hidden text, expose it." (defun org-translate-link (s) "Translate a link string if a translation function has been defined." - (if (and org-link-translation-function - (fboundp org-link-translation-function) - (string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s)) - (progn - (setq s (funcall org-link-translation-function - (match-string 1 s) (match-string 2 s))) - (concat (car s) ":" (cdr s))) - s)) + (with-temp-buffer + (insert (org-trim s)) + (org-trim (org-element-interpret-data (org-element-context))))) (defun org-translate-link-from-planner (type path) "Translate a link from Emacs Planner syntax so that Org can follow it. diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 73a54595d..a23001b66 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -2942,29 +2942,34 @@ DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu (ert-deftest test-org-element/link-interpreter () "Test link interpreter." - ;; 1. Links targeted from a radio target. + ;; Links targeted from a radio target. (should (equal (let ((org-target-link-regexp "radio-target")) (org-test-parse-and-interpret "a radio-target")) "a radio-target\n")) - ;; 2. Regular links. - ;; - ;; 2.1. Without description. + ;; Links without description. (should (equal (org-test-parse-and-interpret "[[http://orgmode.org]]") "[[http://orgmode.org]]\n")) - ;; 2.2. With a description. + ;; Links with a description. (should (equal (org-test-parse-and-interpret "[[http://orgmode.org][Org mode]]") "[[http://orgmode.org][Org mode]]\n")) - ;; 2.3. Id links. + ;; File links. + (should + (equal (org-test-parse-and-interpret "[[file+emacs:todo.org]]") + "[[file+emacs:todo.org]]\n")) + (should + (equal (org-test-parse-and-interpret "[[file:todo.org::*task]]") + "[[file:todo.org::*task]]\n")) + ;; Id links. (should (equal (org-test-parse-and-interpret "[[id:aaaa]]") "[[id:aaaa]]\n")) - ;; 2.4. Custom-id links. + ;; Custom-id links. (should (equal (org-test-parse-and-interpret "[[#id]]") "[[#id]]\n")) - ;; 2.5 Code-ref links. + ;; Code-ref links. (should (equal (org-test-parse-and-interpret "[[(ref)]]") "[[(ref)]]\n")) - ;; 3. Normalize plain links. + ;; Normalize plain links. (should (equal (org-test-parse-and-interpret "http://orgmode.org") "[[http://orgmode.org]]\n")) - ;; 4. Normalize angular links. + ;; Normalize angular links. (should (equal (org-test-parse-and-interpret "") "[[http://orgmode.org]]\n")))