From 870f01312242fcbc56a66efb3a10d5bcf42144d6 Mon Sep 17 00:00:00 2001 From: Mikhail Skorzhinskii Date: Mon, 21 Sep 2020 14:53:13 +0200 Subject: [PATCH 3/3] org-refile.el: Show refile targets with a title * lisp/org-refile.el (org-refile-get-targets): Use a document title (#+TITLE) instead of file or buffer name in outline path, if a corresponding customisation option is set to 'title. Fallback to a filename if there is no title in the document. * lisp/org-refile.el (org-refile-use-outline-path): Add a new option 'title, see above. --- etc/ORG-NEWS | 6 +++++ lisp/org-refile.el | 17 ++++++++++--- testing/lisp/test-org.el | 55 +++++++++++++++++++++++++++++++++++++++- 3 files changed, 74 insertions(+), 4 deletions(-) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 7b64f1b9d..2a2501c45 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -324,6 +324,12 @@ value of ~org-babel-clojure-backend~. For example: #+end_src ** New options +*** A new option for custom setting ~org-refile-use-outline-path~ to show document title in refile targets + +Setting ~org-refile-use-outline-path~ to ~'title~ will show title +instead of the file name in refile targets. If the documen do not have +a title, the filename will be used, similar to ~'file~ option. + *** A new option for custom setting ~org-agenda-show-outline-path~ to show document title Setting ~org-agenda-show-outline-path~ to ~'title~ will show title diff --git a/lisp/org-refile.el b/lisp/org-refile.el index edab0b225..6dd76d380 100644 --- a/lisp/org-refile.el +++ b/lisp/org-refile.el @@ -160,7 +160,8 @@ When `buffer-name', use the buffer name." (const :tag "Yes" t) (const :tag "Start with file name" file) (const :tag "Start with full file path" full-file-path) - (const :tag "Start with buffer name" buffer-name))) + (const :tag "Start with buffer name" buffer-name) + (const :tag "Start with document title" title))) (defcustom org-outline-path-complete-in-steps t "Non-nil means complete the outline path in hierarchical steps. @@ -319,6 +320,11 @@ converted to a headline before refiling." (push (list (and (buffer-file-name (buffer-base-buffer)) (file-truename (buffer-file-name (buffer-base-buffer)))) f nil nil) tgs)) + (when (eq org-refile-use-outline-path 'title) + (push (list (or (org-get-title) + (and f (file-name-nondirectory f))) + f nil nil) + tgs)) (org-with-wide-buffer (goto-char (point-min)) (setq org-outline-path-cache nil) @@ -345,7 +351,12 @@ converted to a headline before refiling." (and (buffer-file-name (buffer-base-buffer)) (file-name-nondirectory (buffer-file-name (buffer-base-buffer)))))) - (`full-file-path + (`title (list + (or (org-get-title) + (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)))) (`buffer-name @@ -633,7 +644,7 @@ this function appends the default value from (tbl (mapcar (lambda (x) (if (and (not (member org-refile-use-outline-path - '(file full-file-path))) + '(file full-file-path title))) (not (equal filename (nth 1 x)))) (cons (concat (car x) extra " (" (file-name-nondirectory (nth 1 x)) ")") diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 4a6a3a0b0..334022c98 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -6821,7 +6821,60 @@ Paragraph" (org-test-with-temp-text "* H1" (let* ((org-refile-use-outline-path 'buffer-name) (org-refile-targets `((nil :level . 1)))) - (member (buffer-name) (mapcar #'car (org-refile-get-targets))))))) + (member (buffer-name) (mapcar #'car (org-refile-get-targets)))))) + ;; When `org-refile-use-outline-path' is `title', return extracted + ;; document title + (should + (equal '("T" "T/H1") + (org-test-with-temp-text-in-file "#+title: T\n* H1" + (let* ((org-refile-use-outline-path 'title) + (org-refile-targets `((nil :level . 1)))) + (mapcar #'car (org-refile-get-targets)))))) + ;; When `org-refile-use-outline-path' is `title' validate that + ;; deeper levels are correctly reported too (the same behaviour as + ;; 'file) + (should + (equal '("T" "T/H1" "T/H1/H2" "T/H1/H2/H3" "T/H1") + (org-test-with-temp-text-in-file "#+title: T\n* H1\n** H2\n*** H3\n* H1" + (let ((org-refile-use-outline-path 'title) + (org-refile-targets `((nil :maxlevel . 3)))) + (mapcar #'car (org-refile-get-targets)))))) + ;; When `org-refile-use-outline-path' is `title' and document do not + ;; have an extracted document title, return just the file name + (should + (org-test-with-temp-text-in-file "* H1" + (let* ((filename (buffer-file-name)) + (org-refile-use-outline-path 'title) + (org-refile-targets `((nil :level . 1)))) + (member (file-name-nondirectory filename) + (mapcar #'car (org-refile-get-targets)))))) + ;; When `org-refile-use-outline-path' is `title' and document is a + ;; temporary buffer without a file, it is still possible to extract + ;; a title + (should + (equal '("T" "T/H1") + (org-test-with-temp-text "#+title: T\n* H1\n** H2" + (let* ((org-refile-use-outline-path 'title) + (org-refile-targets `((nil :level . 1)))) + (mapcar #'car (org-refile-get-targets)))))) + ;; When `org-refile-use-outline-path' is `title' and there are two + ;; title keywords in the file, titles are concatenated into a single + ;; one. + (should + (equal '("T1 T2" "T1 T2/H1") + (org-test-with-temp-text "#+title: T1\n#+title: T2\n* H1\n** H2" + (let* ((org-refile-use-outline-path 'title) + (org-refile-targets `((nil :level . 1)))) + (mapcar #'car (org-refile-get-targets)))))) + ;; When `org-refile-use-outline-path' is `title' and there are two + ;; title keywords in the file, titles are concatenated into a single + ;; one even if they are in the middle of the file. + (should + (equal '("T1 T2" "T1 T2/H1") + (org-test-with-temp-text "#+title: T1\n* H1\n** H2\n#+title: T2\n" + (let* ((org-refile-use-outline-path 'title) + (org-refile-targets `((nil :level . 1)))) + (mapcar #'car (org-refile-get-targets))))))) -- 2.35.1