mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2025-01-05 11:45:52 +00:00
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:
parent
1abc4887a2
commit
93b73bd303
@ -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) "")))))
|
||||
|
||||
|
||||
|
11
lisp/org.el
11
lisp/org.el
@ -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.
|
||||
|
@ -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")))
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user