Fix translated link

* lisp/org-element.el (org-element-link-parser): Call
  `org-link-translation-function' if required.
(org-element-link-interpreter): Build link from type and path instead of
simply pasting raw value.

* lisp/org.el (org-translate-link): Call parser to extract proper path
  and type.

* testing/lisp/test-org-element.el (test-org-element/link-interpreter):
  Add test.

Reported-by: Sergei Nosov <sergei.nosov@gmail.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/100227>
This commit is contained in:
Nicolas Goaziou 2015-08-19 15:12:57 +02:00
parent 1abc4887a2
commit 93b73bd303
3 changed files with 61 additions and 47 deletions

View File

@ -3059,11 +3059,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.
@ -3116,36 +3115,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) "")))))

View File

@ -10565,14 +10565,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.

View File

@ -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>")
"[[http://orgmode.org]]\n")))