Merge branch 'maint'

This commit is contained in:
Nicolas Goaziou 2015-08-19 15:23:47 +02:00
commit 3733658bb5
3 changed files with 61 additions and 47 deletions

View File

@ -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) "")))))

View File

@ -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.

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")))