From e6d3aae4a75e50423924e0eacbcd94cdea7dafe8 Mon Sep 17 00:00:00 2001 From: Mikhail Skorzhinskii Date: Mon, 21 Sep 2020 14:53:13 +0200 Subject: [PATCH 2/5] org-refile.el: show refile targets with doc. title * lisp/org-refile.el (org-refile-use-outline-path): add an option 'title * lisp/org-refile.el (org-refile-get-targets): start refile target outline with document title (#+title) instead of file name --- lisp/org-refile.el | 18 +++++++++++++++--- testing/lisp/test-org.el | 29 ++++++++++++++++++++++++++++- 2 files changed, 43 insertions(+), 4 deletions(-) diff --git a/lisp/org-refile.el b/lisp/org-refile.el index 678759e10..644e9f497 100644 --- a/lisp/org-refile.el +++ b/lisp/org-refile.el @@ -158,7 +158,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. @@ -317,6 +318,9 @@ 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-from-file (file-truename (buffer-file-name (buffer-base-buffer)))) + (and f (file-name-nondirectory f))) f nil nil) tgs)) (org-with-wide-buffer (goto-char (point-min)) (setq org-outline-path-cache nil) @@ -343,7 +347,15 @@ 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-from-file + (file-truename + (buffer-file-name (buffer-base-buffer)))) + (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 @@ -631,7 +643,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 056ea7d87..a6df00baf 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -6435,7 +6435,34 @@ 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* ((filename (buffer-file-name)) + (org-refile-use-outline-path 'title) + (org-refile-targets `(((,filename) :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 `(((,filename) :level . 1)))) + (member (file-name-nondirectory filename) + (mapcar #'car (org-refile-get-targets))))))) -- 2.32.0