Merge branch 'maint'

This commit is contained in:
Bastien 2021-05-15 10:33:34 +02:00
commit e2cf4369d6
3 changed files with 149 additions and 15 deletions

View File

@ -512,7 +512,10 @@ links more efficient."
"Matches link with angular brackets, spaces are allowed.")
(defvar org-link-plain-re nil
"Matches plain link, without spaces.")
"Matches plain link, without spaces.
Group 1 must contain the link type (i.e. https).
Group 2 must contain the link path (i.e. //example.com).
Used by `org-element-link-parser'.")
(defvar org-link-bracket-re nil
"Matches a link in double brackets.")
@ -800,15 +803,33 @@ This should be called after the variable `org-link-parameters' has changed."
(format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>"
types-re)
org-link-plain-re
(concat
"\\<" types-re ":"
"\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")
;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
org-link-bracket-re
(rx (seq "[["
;; URI part: match group 1.
(group
(one-or-more
(let* ((non-space-bracket "[^][ \t\n()<>]")
(parenthesis
`(seq "("
(0+ (or (regex ,non-space-bracket)
(seq "("
(0+ (regex ,non-space-bracket))
")")))
")")))
;; Heuristics for an URL link inspired by
;; https://daringfireball.net/2010/07/improved_regex_for_matching_urls
(rx-to-string
`(seq word-start
;; Link type: match group 1.
(regexp ,types-re)
":"
;; Link path: match group 2.
(group
(1+ (or (regex ,non-space-bracket)
,parenthesis))
(or (regexp "[^[:punct:] \t\n]")
?/
,parenthesis)))))
org-link-bracket-re
(rx (seq "[["
;; URI part: match group 1.
(group
(one-or-more
(or (not (any "[]\\"))
(and "\\" (zero-or-more "\\\\") (any "[]"))
(and (one-or-more "\\") (not (any "[]"))))))

View File

@ -310,11 +310,13 @@ converted to a headline before refiling."
(setq f (buffer-file-name (buffer-base-buffer f))))
(setq f (and f (expand-file-name f)))
(when (eq org-refile-use-outline-path 'file)
(push (list (file-name-nondirectory f) f nil nil) tgs))
(push (list (and f (file-name-nondirectory f)) f nil nil) tgs))
(when (eq org-refile-use-outline-path 'buffer-name)
(push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs))
(when (eq org-refile-use-outline-path 'full-file-path)
(push (list (file-truename (buffer-file-name (buffer-base-buffer))) f nil nil) tgs))
(push (list (and (buffer-file-name (buffer-base-buffer))
(file-truename (buffer-file-name (buffer-base-buffer))))
f nil nil) tgs))
(org-with-wide-buffer
(goto-char (point-min))
(setq org-outline-path-cache nil)
@ -337,9 +339,10 @@ converted to a headline before refiling."
#'identity
(append
(pcase org-refile-use-outline-path
(`file (list (file-name-nondirectory
(buffer-file-name
(buffer-base-buffer)))))
(`file (list
(and (buffer-file-name (buffer-base-buffer))
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))
(`full-file-path
(list (buffer-file-name
(buffer-base-buffer))))

View File

@ -491,5 +491,115 @@
(org-previous-link))
(buffer-substring (point) (line-end-position))))))
;;; Link regexps
(defmacro test-ol-parse-link-in-text (text)
"Return list of :type and :path of link parsed in TEXT.
\"<point>\" string must be at the beginning of the link to be parsed."
(declare (indent 1))
`(org-test-with-temp-text ,text
(list (org-element-property :type (org-element-link-parser))
(org-element-property :path (org-element-link-parser)))))
(ert-deftest test-ol/plain-link-re ()
"Test `org-link-plain-re'."
(should
(equal
'("https" "//example.com")
(test-ol-parse-link-in-text
"(<point>https://example.com)")))
(should
(equal
'("https" "//example.com/qwe()")
(test-ol-parse-link-in-text
"(Some text <point>https://example.com/qwe())")))
(should
(equal
'("https" "//doi.org/10.1016/0160-791x(79)90023-x")
(test-ol-parse-link-in-text
"<point>https://doi.org/10.1016/0160-791x(79)90023-x")))
(should
(equal
'("file" "aa")
(test-ol-parse-link-in-text
"The <point>file:aa link")))
(should
(equal
'("file" "a(b)c")
(test-ol-parse-link-in-text
"The <point>file:a(b)c link")))
(should
(equal
'("file" "a()")
(test-ol-parse-link-in-text
"The <point>file:a() link")))
(should
(equal
'("file" "aa((a))")
(test-ol-parse-link-in-text
"The <point>file:aa((a)) link")))
(should
(equal
'("file" "aa(())")
(test-ol-parse-link-in-text
"The <point>file:aa(()) link")))
(should
(equal
'("file" "/a")
(test-ol-parse-link-in-text
"The <point>file:/a link")))
(should
(equal
'("file" "/a/")
(test-ol-parse-link-in-text
"The <point>file:/a/ link")))
(should
(equal
'("http" "//")
(test-ol-parse-link-in-text
"The <point>http:// link")))
(should
(equal
'("file" "ab")
(test-ol-parse-link-in-text
"The (some <point>file:ab) link")))
(should
(equal
'("file" "aa")
(test-ol-parse-link-in-text
"The <point>file:aa) link")))
(should
(equal
'("file" "aa")
(test-ol-parse-link-in-text
"The <point>file:aa( link")))
(should
(equal
'("http" "//foo.com/more_(than)_one_(parens)")
(test-ol-parse-link-in-text
"The <point>http://foo.com/more_(than)_one_(parens) link")))
(should
(equal
'("http" "//foo.com/blah_(wikipedia)#cite-1")
(test-ol-parse-link-in-text
"The <point>http://foo.com/blah_(wikipedia)#cite-1 link")))
(should
(equal
'("http" "//foo.com/blah_(wikipedia)_blah#cite-1")
(test-ol-parse-link-in-text
"The <point>http://foo.com/blah_(wikipedia)_blah#cite-1 link")))
(should
(equal
'("http" "//foo.com/unicode_(✪)_in_parens")
(test-ol-parse-link-in-text
"The <point>http://foo.com/unicode_(✪)_in_parens link")))
(should
(equal
'("http" "//foo.com/(something)?after=parens")
(test-ol-parse-link-in-text
"The <point>http://foo.com/(something)?after=parens link"))))
(provide 'test-ol)
;;; test-ol.el ends here