summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2020-02-19 18:03:53 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2020-02-19 18:42:50 +0100
commit12c09be3a6aa629d055841739ebc1da0ae76cf26 (patch)
tree821bcbd1c32f902079b8a22253d1fe3c4e69199d
parent8c4e270df280a08b7e61295712c86246088146ba (diff)
downloadorg-mode-12c09be3a6aa629d055841739ebc1da0ae76cf26.tar.gz
Refactor context part in file links
* lisp/ol.el (org-link--context-from-region): (org-link--squeeze-white-spaces): New functions. (org-link-heading-search-string): Refactor code. Always start with an asterisk. (org-store-link): Use new functions. * lisp/org-pcomplete.el (pcomplete/org-mode/searchhead): * testing/lisp/test-org-clock.el (test-org-clock/clocktable/link): Update tests.
-rw-r--r--lisp/ol.el106
-rw-r--r--lisp/org-pcomplete.el5
-rw-r--r--testing/lisp/test-org-clock.el20
3 files changed, 71 insertions, 60 deletions
diff --git a/lisp/ol.el b/lisp/ol.el
index 4a05bc6..f3e3f2b 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -45,6 +45,7 @@
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(declare-function org-at-heading-p "org" (&optional _))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-before-first-heading-p "org" ())
(declare-function org-do-occur "org" (regexp &optional cleanup))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-cache-refresh "org-element" (pos))
@@ -57,7 +58,6 @@
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-find-property "org" (property &optional value))
(declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
-(declare-function org-heading-components "org" ())
(declare-function org-id-find-id-file "org-id" (id))
(declare-function org-id-store-link "org-id" ())
(declare-function org-insert-heading "org" (&optional arg invisible-ok top))
@@ -731,6 +731,23 @@ White spaces are not significant."
(goto-char origin)
(user-error "No match for radio target: %s" target))))
+(defun org-link--context-from-region ()
+ "Return context string from active region, or nil."
+ (when (org-region-active-p)
+ (let ((context (buffer-substring (region-beginning) (region-end))))
+ (when (and (wholenump org-link-context-for-files)
+ (> org-link-context-for-files 0))
+ (let ((lines (org-split-string context "\n")))
+ (setq context
+ (mapconcat #'identity
+ (cl-subseq lines 0 org-link-context-for-files)
+ "\n"))))
+ (org-link--squeeze-white-spaces context))))
+
+(defun org-link--squeeze-white-spaces (string)
+ "Trim STRING, pack contiguous white spaces, and return it."
+ (replace-regexp-in-string "[ \t\n]+" " " (org-trim string)))
+
;;; Public API
@@ -1221,24 +1238,23 @@ of matched result, which is either `dedicated' or `fuzzy'."
type))
(defun org-link-heading-search-string (&optional string)
- "Make search string for the current headline or STRING."
- (let ((s (or string
- (and (derived-mode-p 'org-mode)
- (save-excursion
- (org-back-to-heading t)
- (org-element-property :raw-value
- (org-element-at-point))))))
- (lines org-link-context-for-files))
- (unless string (setq s (concat "*" s))) ;Add * for headlines
- (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s))
- (when (and string (integerp lines) (> lines 0))
- (let ((slines (org-split-string s "\n")))
- (when (< lines (length slines))
- (setq s (mapconcat
- #'identity
- (reverse (nthcdr (- (length slines) lines)
- (reverse slines))) "\n")))))
- (mapconcat #'identity (split-string s) " ")))
+ "Make search string for the current headline or STRING.
+When optional argument STRING is non-nil, assume it a headline.
+Search string starts with an asterisk. COMMENT keyword and
+statistics cookies are removed, and contiguous spaces are packed
+into a single one."
+ (let ((context
+ (if (not string)
+ (concat "*" (org-trim (org-get-heading nil nil nil t)))
+ (let ((s (org-trim string))
+ (comment-re (format "\\`%s[ \t]+" org-comment-string)))
+ (unless (string-prefix-p "*" s) (setq s (concat "*" s)))
+ (replace-regexp-in-string comment-re "" s))))
+ (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]"))
+ (org-trim
+ (replace-regexp-in-string
+ cookie-re ""
+ (org-link--squeeze-white-spaces context)))))
(defun org-link-open-as-file (path arg)
"Pretend PATH is a file name and open it.
@@ -1446,7 +1462,7 @@ non-nil."
(move-beginning-of-line 2)
(set-mark (point)))))
(setq org-store-link-plist nil)
- (let (link cpltxt desc description search txt custom-id agenda-link)
+ (let (link cpltxt desc description search custom-id agenda-link)
(cond
;; Store a link using an external link type, if any function is
;; available. If more than one can generate a link from current
@@ -1605,30 +1621,25 @@ non-nil."
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer))))))))
(t
- ;; Just link to current headline
+ ;; Just link to current headline.
(setq cpltxt (concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string
+ ;; Add a context search string.
(when (org-xor org-link-context-for-files (equal arg '(4)))
(let* ((element (org-element-at-point))
- (name (org-element-property :name element)))
- (setq txt (cond
- ((org-at-heading-p) nil)
- (name)
- ((org-region-active-p)
- (buffer-substring (region-beginning) (region-end)))))
- (when (or (null txt) (string-match "\\S-" txt))
- (setq cpltxt
- (concat cpltxt "::"
- (condition-case nil
- (org-link-heading-search-string txt)
- (error "")))
- desc (or name
- (nth 4 (ignore-errors (org-heading-components)))
- "NONE")))))
- (when (string-match "::\\'" cpltxt)
- (setq cpltxt (substring cpltxt 0 -2)))
+ (name (org-element-property :name element))
+ (context
+ (cond
+ ((org-link--context-from-region))
+ (name)
+ ((org-before-first-heading-p)
+ (org-link--squeeze-white-spaces
+ (org-current-line-string)))
+ (t (org-link-heading-search-string)))))
+ (when (org-string-nw-p context)
+ (setq cpltxt (format "%s::%s" cpltxt context))
+ (setq desc (or name (org-get-heading t t t t) "NONE")))))
(setq link cpltxt)))))
((buffer-file-name (buffer-base-buffer))
@@ -1636,16 +1647,15 @@ non-nil."
(setq cpltxt (concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
- ;; Add a context string.
+ ;; Add a context search string.
(when (org-xor org-link-context-for-files (equal arg '(4)))
- (setq txt (if (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))
- (buffer-substring (point-at-bol) (point-at-eol))))
- ;; Only use search option if there is some text.
- (when (string-match "\\S-" txt)
- (setq cpltxt
- (concat cpltxt "::" (org-link-heading-search-string txt))
- desc "NONE")))
+ (let ((context (or (org-link--context-from-region)
+ (org-link--squeeze-white-spaces
+ (org-current-line-string)))))
+ ;; Only use search option if there is some text.
+ (when (org-string-nw-p context)
+ (setq cpltxt (format "%s::%s" cpltxt context))
+ (setq desc "NONE"))))
(setq link cpltxt))
(interactive?
diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el
index 39c1209..28b40fa 100644
--- a/lisp/org-pcomplete.el
+++ b/lisp/org-pcomplete.el
@@ -352,8 +352,9 @@ This needs more work, to handle headings with lots of spaces in them."
(goto-char (point-min))
(let (tbl)
(while (re-search-forward org-outline-regexp nil t)
- (push (org-link-heading-search-string (org-get-heading t t t t))
- tbl))
+ ;; Remove the leading asterisk from
+ ;; `org-link-heading-search-string' result.
+ (push (substring (org-link-heading-search-string) 1) tbl))
(pcomplete-uniquify-list tbl)))
;; When completing a bracketed link, i.e., "[[*", argument
;; starts at the star, so remove this character.
diff --git a/testing/lisp/test-org-clock.el b/testing/lisp/test-org-clock.el
index daca229..dbbcb81 100644
--- a/testing/lisp/test-org-clock.el
+++ b/testing/lisp/test-org-clock.el
@@ -577,7 +577,7 @@ CLOCK: [2016-12-28 Wed 13:09]--[2016-12-28 Wed 15:09] => 2:00"
;; If there is no file attached to the document, link directly to
;; the headline.
(should
- (string-match-p "| +\\[\\[Foo]\\[Foo]] +| 26:00 +|"
+ (string-match-p "| +\\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
(org-test-with-temp-text
"* Foo
CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
@@ -585,7 +585,7 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
;; Otherwise, link to the headline in the current file.
(should
(string-match-p
- "| \\[\\[file:filename::Foo]\\[Foo]] +| 26:00 +|"
+ "| \\[\\[file:filename::\\*Foo]\\[Foo]] +| 26:00 +|"
(org-test-with-temp-text
(org-test-with-temp-text-in-file
"* Foo
@@ -600,28 +600,28 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
;; headline.
(should
(string-match-p
- "| \\[\\[Foo]\\[Foo]] +| 26:00 +|"
+ "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
(org-test-with-temp-text
"* TODO Foo
CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
(test-org-clock-clocktable-contents ":link t :lang en"))))
(should
(string-match-p
- "| \\[\\[Foo]\\[Foo]] +| 26:00 +|"
+ "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
(org-test-with-temp-text
"* [#A] Foo
CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
(test-org-clock-clocktable-contents ":link t :lang en"))))
(should
(string-match-p
- "| \\[\\[Foo]\\[Foo]] +| 26:00 +|"
+ "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
(org-test-with-temp-text
"* COMMENT Foo
CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
(test-org-clock-clocktable-contents ":link t"))))
(should
(string-match-p
- "| \\[\\[Foo]\\[Foo]] +| 26:00 +|"
+ "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
(org-test-with-temp-text
"* Foo :tag:
CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
@@ -629,14 +629,14 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
;; Remove statistics cookie from headline description.
(should
(string-match-p
- "| \\[\\[Foo]\\[Foo]] +| 26:00 +|"
+ "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
(org-test-with-temp-text
"* Foo [50%]
CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
(test-org-clock-clocktable-contents ":link t :lang en"))))
(should
(string-match-p
- "| \\[\\[Foo]\\[Foo]] +| 26:00 +|"
+ "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
(org-test-with-temp-text
"* Foo [1/2]
CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
@@ -645,14 +645,14 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
;; links if there is no description.
(should
(string-match-p
- "| \\[\\[Foo \\\\\\[\\\\\\[https://orgmode\\.org\\\\]\\\\\\[Org mode\\\\]\\\\]]\\[Foo Org mode]] +| 26:00 +|"
+ "| \\[\\[\\*Foo \\\\\\[\\\\\\[https://orgmode\\.org\\\\]\\\\\\[Org mode\\\\]\\\\]]\\[Foo Org mode]] +| 26:00 +|"
(org-test-with-temp-text
"* Foo [[https://orgmode.org][Org mode]]
CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
(test-org-clock-clocktable-contents ":link t :lang en"))))
(should
(string-match-p
- "| \\[\\[Foo \\\\\\[\\\\\\[https://orgmode\\.org\\\\]\\\\]]\\[Foo https://orgmode\\.org]] +| 26:00 +|"
+ "| \\[\\[\\*Foo \\\\\\[\\\\\\[https://orgmode\\.org\\\\]\\\\]]\\[Foo https://orgmode\\.org]] +| 26:00 +|"
(org-test-with-temp-text
"* Foo [[https://orgmode.org]]
CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"