org-refile.el 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754
  1. ;;; org-refile.el --- Refile Org Subtrees -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2010-2022 Free Software Foundation, Inc.
  3. ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
  4. ;; Keywords: outlines, hypermedia, calendar, wp
  5. ;;
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software: you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; Org Refile allows you to refile subtrees to various locations.
  19. ;;; Code:
  20. (require 'org-macs)
  21. (org-assert-version)
  22. (require 'org)
  23. (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
  24. (defgroup org-refile nil
  25. "Options concerning refiling entries in Org mode."
  26. :tag "Org Refile"
  27. :group 'org)
  28. (defcustom org-log-refile nil
  29. "Information to record when a task is refiled.
  30. Possible values are:
  31. nil Don't add anything
  32. time Add a time stamp to the task
  33. note Prompt for a note and add it with template `org-log-note-headings'
  34. This option can also be set with on a per-file-basis with
  35. #+STARTUP: nologrefile
  36. #+STARTUP: logrefile
  37. #+STARTUP: lognoterefile
  38. You can have local logging settings for a subtree by setting the LOGGING
  39. property to one or more of these keywords.
  40. When bulk-refiling, e.g., from the agenda, the value `note' is
  41. forbidden and will temporarily be changed to `time'."
  42. :group 'org-refile
  43. :group 'org-progress
  44. :version "24.1"
  45. :type '(choice
  46. (const :tag "No logging" nil)
  47. (const :tag "Record timestamp" time)
  48. (const :tag "Record timestamp with note." note)))
  49. (defcustom org-refile-targets nil
  50. "Targets for refiling entries with `\\[org-refile]'.
  51. This is a list of cons cells. Each cell contains:
  52. - a specification of the files to be considered, either a list of files,
  53. or a symbol whose function or variable value will be used to retrieve
  54. a file name or a list of file names. If you use `org-agenda-files' for
  55. that, all agenda files will be scanned for targets. Nil means consider
  56. headings in the current buffer.
  57. - A specification of how to find candidate refile targets. This may be
  58. any of:
  59. - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
  60. This tag has to be present in all target headlines, inheritance will
  61. not be considered.
  62. - a cons cell (:todo . \"KEYWORD\") to identify refile targets by
  63. todo keyword.
  64. - a cons cell (:regexp . \"REGEXP\") with a regular expression matching
  65. headlines that are refiling targets.
  66. - a cons cell (:level . N). Any headline of level N is considered a target.
  67. Note that, when `org-odd-levels-only' is set, level corresponds to
  68. order in hierarchy, not to the number of stars.
  69. - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
  70. Note that, when `org-odd-levels-only' is set, level corresponds to
  71. order in hierarchy, not to the number of stars.
  72. Each element of this list generates a set of possible targets.
  73. The union of these sets is presented (with completion) to
  74. the user by `org-refile'.
  75. You can set the variable `org-refile-target-verify-function' to a function
  76. to verify each headline found by the simple criteria above.
  77. When this variable is nil, all top-level headlines in the current buffer
  78. are used, equivalent to the value `((nil . (:level . 1)))'."
  79. :group 'org-refile
  80. :type '(repeat
  81. (cons
  82. (choice :value org-agenda-files
  83. (const :tag "All agenda files" org-agenda-files)
  84. (const :tag "Current buffer" nil)
  85. (function) (variable) (file))
  86. (choice :tag "Identify target headline by"
  87. (cons :tag "Specific tag" (const :value :tag) (string))
  88. (cons :tag "TODO keyword" (const :value :todo) (string))
  89. (cons :tag "Regular expression" (const :value :regexp) (regexp))
  90. (cons :tag "Level number" (const :value :level) (integer))
  91. (cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
  92. (defcustom org-refile-target-verify-function nil
  93. "Function to verify if the headline at point should be a refile target.
  94. The function will be called without arguments, with point at the
  95. beginning of the headline. It should return t and leave point
  96. where it is if the headline is a valid target for refiling.
  97. If the target should not be selected, the function must return nil.
  98. In addition to this, it may move point to a place from where the search
  99. should be continued. For example, the function may decide that the entire
  100. subtree of the current entry should be excluded and move point to the end
  101. of the subtree."
  102. :group 'org-refile
  103. :type '(choice
  104. (const nil)
  105. (function)))
  106. (defcustom org-refile-use-cache nil
  107. "Non-nil means cache refile targets to speed up the process.
  108. \\<org-mode-map>\
  109. The cache for a particular file will be updated automatically when
  110. the buffer has been killed, or when any of the marker used for flagging
  111. refile targets no longer points at a live buffer.
  112. If you have added new entries to a buffer that might themselves be targets,
  113. you need to clear the cache manually by pressing `C-0 \\[org-refile]' or,
  114. if you find that easier, \
  115. `\\[universal-argument] \\[universal-argument] \\[universal-argument] \
  116. \\[org-refile]'."
  117. :group 'org-refile
  118. :version "24.1"
  119. :type 'boolean)
  120. (defcustom org-refile-use-outline-path nil
  121. "Non-nil means provide refile targets as paths.
  122. So a level 3 headline will be available as level1/level2/level3.
  123. When the value is `file', also include the file name (without directory)
  124. into the path. In this case, you can also stop the completion after
  125. the file name, to get entries inserted as top level in the file.
  126. When `full-file-path', include the full file path.
  127. When `buffer-name', use the buffer name."
  128. :group 'org-refile
  129. :type '(choice
  130. (const :tag "Not" nil)
  131. (const :tag "Yes" t)
  132. (const :tag "Start with file name" file)
  133. (const :tag "Start with full file path" full-file-path)
  134. (const :tag "Start with buffer name" buffer-name)))
  135. (defcustom org-outline-path-complete-in-steps t
  136. "Non-nil means complete the outline path in hierarchical steps.
  137. When Org uses the refile interface to select an outline path (see
  138. `org-refile-use-outline-path'), the completion of the path can be
  139. done in a single go, or it can be done in steps down the headline
  140. hierarchy. Going in steps is probably the best if you do not use
  141. a special completion package like `ido' or `icicles'. However,
  142. when using these packages, going in one step can be very fast,
  143. while still showing the whole path to the entry."
  144. :group 'org-refile
  145. :type 'boolean)
  146. (defcustom org-refile-allow-creating-parent-nodes nil
  147. "Non-nil means allow the creation of new nodes as refile targets.
  148. New nodes are then created by adding \"/new node name\" to the completion
  149. of an existing node. When the value of this variable is `confirm',
  150. new node creation must be confirmed by the user (recommended).
  151. When nil, the completion must match an existing entry.
  152. Note that, if the new heading is not seen by the criteria
  153. listed in `org-refile-targets', multiple instances of the same
  154. heading would be created by trying again to file under the new
  155. heading."
  156. :group 'org-refile
  157. :type '(choice
  158. (const :tag "Never" nil)
  159. (const :tag "Always" t)
  160. (const :tag "Prompt for confirmation" confirm)))
  161. (defcustom org-refile-active-region-within-subtree nil
  162. "Non-nil means also refile active region within a subtree.
  163. By default `org-refile' doesn't allow refiling regions if they
  164. don't contain a set of subtrees, but it might be convenient to
  165. do so sometimes: in that case, the first line of the region is
  166. converted to a headline before refiling."
  167. :group 'org-refile
  168. :version "24.1"
  169. :type 'boolean)
  170. (defvar org-refile-target-table nil
  171. "The list of refile targets, created by `org-refile'.")
  172. (defvar org-refile-cache nil
  173. "Cache for refile targets.")
  174. (defvar org-refile-markers nil
  175. "All the markers used for caching refile locations.")
  176. ;; Add org refile commands to the main org menu
  177. (mapc (lambda (i) (easy-menu-add-item
  178. org-org-menu
  179. '("Edit Structure") i))
  180. '(["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
  181. ["Refile and copy Subtree" org-refile-copy (org-in-subtree-not-table-p)]))
  182. (defun org-refile-marker (pos)
  183. "Get a new refile marker, but only if caching is in use."
  184. (if (not org-refile-use-cache)
  185. pos
  186. (let ((m (make-marker)))
  187. (move-marker m pos)
  188. (push m org-refile-markers)
  189. m)))
  190. (defun org-refile-cache-clear ()
  191. "Clear the refile cache and disable all the markers."
  192. (dolist (m org-refile-markers) (move-marker m nil))
  193. (setq org-refile-markers nil)
  194. (setq org-refile-cache nil)
  195. (message "Refile cache has been cleared"))
  196. (defun org-refile-cache-check-set (set)
  197. "Check if all the markers in the cache still have live buffers."
  198. (let (marker)
  199. (catch 'exit
  200. (while (and set (setq marker (nth 3 (pop set))))
  201. ;; If `org-refile-use-outline-path' is 'file, marker may be nil
  202. (when (and marker (null (marker-buffer marker)))
  203. (message "Please regenerate the refile cache with `C-0 C-c C-w'")
  204. (sit-for 3)
  205. (throw 'exit nil)))
  206. t)))
  207. (defun org-refile-cache-put (set &rest identifiers)
  208. "Push the refile targets SET into the cache, under IDENTIFIERS."
  209. (let* ((key (sha1 (prin1-to-string identifiers)))
  210. (entry (assoc key org-refile-cache)))
  211. (if entry
  212. (setcdr entry set)
  213. (push (cons key set) org-refile-cache))))
  214. (defun org-refile-cache-get (&rest identifiers)
  215. "Retrieve the cached value for refile targets given by IDENTIFIERS."
  216. (cond
  217. ((not org-refile-cache) nil)
  218. ((not org-refile-use-cache) (org-refile-cache-clear) nil)
  219. (t
  220. (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers))
  221. org-refile-cache))))
  222. (and set (org-refile-cache-check-set set) set)))))
  223. (defun org-refile-get-targets (&optional default-buffer)
  224. "Produce a table with refile targets."
  225. (let ((case-fold-search nil)
  226. ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
  227. (entries (or org-refile-targets '((nil . (:level . 1)))))
  228. targets tgs files desc descre)
  229. (message "Getting targets...")
  230. (with-current-buffer (or default-buffer (current-buffer))
  231. (dolist (entry entries)
  232. (setq files (car entry) desc (cdr entry))
  233. (cond
  234. ((null files) (setq files (list (current-buffer))))
  235. ((eq files 'org-agenda-files)
  236. (setq files (org-agenda-files 'unrestricted)))
  237. ((and (symbolp files) (fboundp files))
  238. (setq files (funcall files)))
  239. ((and (symbolp files) (boundp files))
  240. (setq files (symbol-value files))))
  241. (when (stringp files) (setq files (list files)))
  242. (cond
  243. ((eq (car desc) :tag)
  244. (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
  245. ((eq (car desc) :todo)
  246. (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
  247. ((eq (car desc) :regexp)
  248. (setq descre (cdr desc)))
  249. ((eq (car desc) :level)
  250. (setq descre (concat "^\\*\\{" (number-to-string
  251. (if org-odd-levels-only
  252. (1- (* 2 (cdr desc)))
  253. (cdr desc)))
  254. "\\}[ \t]")))
  255. ((eq (car desc) :maxlevel)
  256. (setq descre (concat "^\\*\\{1," (number-to-string
  257. (if org-odd-levels-only
  258. (1- (* 2 (cdr desc)))
  259. (cdr desc)))
  260. "\\}[ \t]")))
  261. (t (error "Bad refiling target description %s" desc)))
  262. (dolist (f files)
  263. (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))
  264. (or
  265. (setq tgs (org-refile-cache-get (buffer-file-name) descre))
  266. (progn
  267. (when (bufferp f)
  268. (setq f (buffer-file-name (buffer-base-buffer f))))
  269. (setq f (and f (expand-file-name f)))
  270. (when (eq org-refile-use-outline-path 'file)
  271. (push (list (and f (file-name-nondirectory f)) f nil nil) tgs))
  272. (when (eq org-refile-use-outline-path 'buffer-name)
  273. (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs))
  274. (when (eq org-refile-use-outline-path 'full-file-path)
  275. (push (list (and (buffer-file-name (buffer-base-buffer))
  276. (file-truename (buffer-file-name (buffer-base-buffer))))
  277. f nil nil) tgs))
  278. (org-with-wide-buffer
  279. (goto-char (point-min))
  280. (setq org-outline-path-cache nil)
  281. (while (re-search-forward descre nil t)
  282. (beginning-of-line)
  283. (let ((case-fold-search nil))
  284. (looking-at org-complex-heading-regexp))
  285. (let ((begin (point))
  286. (heading (match-string-no-properties 4)))
  287. (unless (or (and
  288. org-refile-target-verify-function
  289. (not
  290. (funcall org-refile-target-verify-function)))
  291. (not heading))
  292. (let ((re (format org-complex-heading-regexp-format
  293. (regexp-quote heading)))
  294. (target
  295. (if (not org-refile-use-outline-path) heading
  296. (mapconcat
  297. #'identity
  298. (append
  299. (pcase org-refile-use-outline-path
  300. (`file (list
  301. (and (buffer-file-name (buffer-base-buffer))
  302. (file-name-nondirectory
  303. (buffer-file-name (buffer-base-buffer))))))
  304. (`full-file-path
  305. (list (buffer-file-name
  306. (buffer-base-buffer))))
  307. (`buffer-name
  308. (list (buffer-name
  309. (buffer-base-buffer))))
  310. (_ nil))
  311. (mapcar (lambda (s) (replace-regexp-in-string
  312. "/" "\\/" s nil t))
  313. (org-get-outline-path t t)))
  314. "/"))))
  315. (push (list target f re (org-refile-marker (point)))
  316. tgs)))
  317. (when (= (point) begin)
  318. ;; Verification function has not moved point.
  319. (end-of-line)))))))
  320. (when org-refile-use-cache
  321. (org-refile-cache-put tgs (buffer-file-name) descre))
  322. (setq targets (append tgs targets))))))
  323. (message "Getting targets...done")
  324. (delete-dups (nreverse targets))))
  325. (defvar org-refile-history nil
  326. "History for refiling operations.")
  327. (defvar org-after-refile-insert-hook nil
  328. "Hook run after `org-refile' has inserted its stuff at the new location.
  329. Note that this is still *before* the stuff will be removed from
  330. the *old* location.")
  331. (defvar org-refile-keep nil
  332. "Non-nil means `org-refile' will copy instead of refile.")
  333. ;;;###autoload
  334. (defun org-refile-copy ()
  335. "Like `org-refile', but preserve the refiled subtree."
  336. (interactive)
  337. (let ((org-refile-keep t))
  338. (org-refile nil nil nil "Copy")))
  339. ;;;###autoload
  340. (defun org-refile-reverse (&optional arg default-buffer rfloc msg)
  341. "Refile while temporarily toggling `org-reverse-note-order'.
  342. So if `org-refile' would append the entry as the last entry under
  343. the target heading, `org-refile-reverse' will prepend it as the
  344. first entry, and vice-versa."
  345. (interactive "P")
  346. (let ((org-reverse-note-order (not (org-notes-order-reversed-p))))
  347. (org-refile arg default-buffer rfloc msg)))
  348. (defvar org-capture-last-stored-marker)
  349. ;;;###autoload
  350. (defun org-refile (&optional arg default-buffer rfloc msg)
  351. "Move the entry or entries at point to another heading.
  352. The list of target headings is compiled using the information in
  353. `org-refile-targets', which see.
  354. At the target location, the entry is filed as a subitem of the
  355. target heading. Depending on `org-reverse-note-order', the new
  356. subitem will either be the first or the last subitem.
  357. If there is an active region, all entries in that region will be
  358. refiled. However, the region must fulfill the requirement that
  359. the first heading sets the top-level of the moved text.
  360. With a `\\[universal-argument]' ARG, the command will only visit the target \
  361. location
  362. and not actually move anything.
  363. With a prefix `\\[universal-argument] \\[universal-argument]', go to the \
  364. location where the last
  365. refiling operation has put the subtree.
  366. With a numeric prefix argument of `2', refile to the running clock.
  367. With a numeric prefix argument of `3', emulate `org-refile-keep'
  368. being set to t and copy to the target location, don't move it.
  369. Beware that keeping refiled entries may result in duplicated ID
  370. properties.
  371. RFLOC can be a refile location obtained in a different way. It
  372. should be a list with the following 4 elements:
  373. 1. Name - an identifier for the refile location, typically the
  374. headline text
  375. 2. File - the file the refile location is in
  376. 3. nil - used for generating refile location candidates, not
  377. needed when passing RFLOC
  378. 4. Position - the position in the specified file of the
  379. headline to refile under
  380. MSG is a string to replace \"Refile\" in the default prompt with
  381. another verb. E.g. `org-refile-copy' sets this parameter to \"Copy\".
  382. See also `org-refile-use-outline-path'.
  383. If you are using target caching (see `org-refile-use-cache'), you
  384. have to clear the target cache in order to find new targets.
  385. This can be done with a `0' prefix (`C-0 C-c C-w') or a triple
  386. prefix argument (`C-u C-u C-u C-c C-w')."
  387. (interactive "P")
  388. (if (member arg '(0 (64)))
  389. (org-refile-cache-clear)
  390. (let* ((actionmsg (cond (msg msg)
  391. ((equal arg 3) "Refile (and keep)")
  392. (t "Refile")))
  393. (regionp (org-region-active-p))
  394. (region-start (and regionp (region-beginning)))
  395. (region-end (and regionp (region-end)))
  396. (org-refile-keep (if (equal arg 3) t org-refile-keep))
  397. pos it nbuf file level reversed)
  398. (setq last-command nil)
  399. (when regionp
  400. (goto-char region-start)
  401. (beginning-of-line)
  402. (setq region-start (point))
  403. (unless (or (org-kill-is-subtree-p
  404. (buffer-substring region-start region-end))
  405. (prog1 org-refile-active-region-within-subtree
  406. (let ((s (line-end-position)))
  407. (org-toggle-heading)
  408. (setq region-end (+ (- (line-end-position) s) region-end)))))
  409. (user-error "The region is not a (sequence of) subtree(s)")))
  410. (if (equal arg '(16))
  411. (org-refile-goto-last-stored)
  412. (when (or
  413. (and (equal arg 2)
  414. org-clock-hd-marker (marker-buffer org-clock-hd-marker)
  415. (prog1
  416. (setq it (list (or org-clock-heading "running clock")
  417. (buffer-file-name
  418. (marker-buffer org-clock-hd-marker))
  419. ""
  420. (marker-position org-clock-hd-marker)))
  421. (setq arg nil)))
  422. (setq it
  423. (or rfloc
  424. (let (heading-text)
  425. (save-excursion
  426. (unless (and arg (listp arg))
  427. (org-back-to-heading t)
  428. (setq heading-text
  429. (replace-regexp-in-string
  430. org-link-bracket-re
  431. "\\2"
  432. (or (nth 4 (org-heading-components))
  433. ""))))
  434. (org-refile-get-location
  435. (cond ((and arg (listp arg)) "Goto")
  436. (regionp (concat actionmsg " region to"))
  437. (t (concat actionmsg " subtree \""
  438. heading-text "\" to")))
  439. default-buffer
  440. (and (not (equal '(4) arg))
  441. org-refile-allow-creating-parent-nodes)))))))
  442. (setq file (nth 1 it)
  443. pos (nth 3 it))
  444. (when (and (not arg)
  445. pos
  446. (equal (buffer-file-name) file)
  447. (if regionp
  448. (and (>= pos region-start)
  449. (<= pos region-end))
  450. (and (>= pos (point))
  451. (< pos (save-excursion
  452. (org-end-of-subtree t t))))))
  453. (error "Cannot refile to position inside the tree or region"))
  454. (setq nbuf (or (find-buffer-visiting file)
  455. (find-file-noselect file)))
  456. (if (and arg (not (equal arg 3)))
  457. (progn
  458. (pop-to-buffer-same-window nbuf)
  459. (goto-char (cond (pos)
  460. ((org-notes-order-reversed-p) (point-min))
  461. (t (point-max))))
  462. (org-fold-show-context 'org-goto))
  463. (if regionp
  464. (progn
  465. (org-kill-new (buffer-substring region-start region-end))
  466. (org-save-markers-in-region region-start region-end))
  467. (org-copy-subtree 1 nil t))
  468. (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
  469. (find-file-noselect file)))
  470. (setq reversed (org-notes-order-reversed-p))
  471. (org-with-wide-buffer
  472. (if pos
  473. (progn
  474. (goto-char pos)
  475. (setq level (org-get-valid-level (funcall outline-level) 1))
  476. (goto-char
  477. (if reversed
  478. (or (outline-next-heading) (point-max))
  479. (or (save-excursion (org-get-next-sibling))
  480. (org-end-of-subtree t t)
  481. (point-max)))))
  482. (setq level 1)
  483. (if (not reversed)
  484. (goto-char (point-max))
  485. (goto-char (point-min))
  486. (or (outline-next-heading) (goto-char (point-max)))))
  487. (unless (bolp) (newline))
  488. (org-paste-subtree level nil nil t)
  489. ;; Record information, according to `org-log-refile'.
  490. ;; Do not prompt for a note when refiling multiple
  491. ;; headlines, however. Simply add a time stamp.
  492. (cond
  493. ((not org-log-refile))
  494. (regionp
  495. (org-map-region
  496. (lambda () (org-add-log-setup 'refile nil nil 'time))
  497. (point)
  498. (+ (point) (- region-end region-start))))
  499. (t
  500. (org-add-log-setup 'refile nil nil org-log-refile)))
  501. (and org-auto-align-tags
  502. (let ((org-loop-over-headlines-in-active-region nil))
  503. (org-align-tags)))
  504. (let ((bookmark-name (plist-get org-bookmark-names-plist
  505. :last-refile)))
  506. (when bookmark-name
  507. (with-demoted-errors "Bookmark set error: %S"
  508. (bookmark-set bookmark-name))))
  509. ;; If we are refiling for capture, make sure that the
  510. ;; last-capture pointers point here
  511. (when (bound-and-true-p org-capture-is-refiling)
  512. (let ((bookmark-name (plist-get org-bookmark-names-plist
  513. :last-capture-marker)))
  514. (when bookmark-name
  515. (with-demoted-errors "Bookmark set error: %S"
  516. (bookmark-set bookmark-name))))
  517. (move-marker org-capture-last-stored-marker (point)))
  518. (deactivate-mark)
  519. (run-hooks 'org-after-refile-insert-hook)))
  520. (unless org-refile-keep
  521. (if regionp
  522. (delete-region (point) (+ (point) (- region-end region-start)))
  523. (org-preserve-local-variables
  524. (delete-region
  525. (and (org-back-to-heading t) (point))
  526. (min (1+ (buffer-size)) (org-end-of-subtree t t) (point))))))
  527. (when (featurep 'org-inlinetask)
  528. (org-inlinetask-remove-END-maybe))
  529. (setq org-markers-to-move nil)
  530. (message "%s to \"%s\" in file %s: done" actionmsg
  531. (car it) file)))))))
  532. (defun org-refile-goto-last-stored ()
  533. "Go to the location where the last refile was stored."
  534. (interactive)
  535. (bookmark-jump (plist-get org-bookmark-names-plist :last-refile))
  536. (message "This is the location of the last refile"))
  537. (defun org-refile--get-location (refloc tbl)
  538. "When user refile to REFLOC, find the associated target in TBL.
  539. Also check `org-refile-target-table'."
  540. (car (delq
  541. nil
  542. (mapcar
  543. (lambda (r) (or (assoc r tbl)
  544. (assoc r org-refile-target-table)))
  545. (list (replace-regexp-in-string "/$" "" refloc)
  546. (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc))))))
  547. (defun org-refile-get-location (&optional prompt default-buffer new-nodes)
  548. "Prompt the user for a refile location, using PROMPT.
  549. PROMPT should not be suffixed with a colon and a space, because
  550. this function appends the default value from
  551. `org-refile-history' automatically, if that is not empty."
  552. (let ((org-refile-targets org-refile-targets)
  553. (org-refile-use-outline-path org-refile-use-outline-path))
  554. (setq org-refile-target-table (org-refile-get-targets default-buffer)))
  555. (unless org-refile-target-table
  556. (user-error "No refile targets"))
  557. (let* ((cbuf (current-buffer))
  558. (cfn (buffer-file-name (buffer-base-buffer cbuf)))
  559. (cfunc (if (and org-refile-use-outline-path
  560. org-outline-path-complete-in-steps)
  561. #'org-olpath-completing-read
  562. #'completing-read))
  563. (extra (if org-refile-use-outline-path "/" ""))
  564. (cbnex (concat (buffer-name) extra))
  565. (filename (and cfn (expand-file-name cfn)))
  566. (tbl (mapcar
  567. (lambda (x)
  568. (if (and (not (member org-refile-use-outline-path
  569. '(file full-file-path)))
  570. (not (equal filename (nth 1 x))))
  571. (cons (concat (car x) extra " ("
  572. (file-name-nondirectory (nth 1 x)) ")")
  573. (cdr x))
  574. (cons (concat (car x) extra) (cdr x))))
  575. org-refile-target-table))
  576. (completion-ignore-case t)
  577. cdef
  578. (prompt (concat prompt
  579. (or (and (car org-refile-history)
  580. (concat " (default " (car org-refile-history) ")"))
  581. (and (assoc cbnex tbl) (setq cdef cbnex)
  582. (concat " (default " cbnex ")"))) ": "))
  583. pa answ parent-target child parent old-hist)
  584. (setq old-hist org-refile-history)
  585. (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
  586. nil 'org-refile-history
  587. (or cdef (car org-refile-history))))
  588. (if (setq pa (org-refile--get-location answ tbl))
  589. (let ((last-refile-loc (car org-refile-history)))
  590. (org-refile-check-position pa)
  591. (when (or (not org-refile-history)
  592. (not (eq old-hist org-refile-history))
  593. (not (equal (car pa) last-refile-loc)))
  594. (setq org-refile-history
  595. (cons (car pa) (if (assoc last-refile-loc tbl)
  596. org-refile-history
  597. (cdr org-refile-history))))
  598. (when (equal last-refile-loc (nth 1 org-refile-history))
  599. (pop org-refile-history)))
  600. pa)
  601. (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
  602. (progn
  603. (setq parent (match-string 1 answ)
  604. child (match-string 2 answ))
  605. (setq parent-target (org-refile--get-location parent tbl))
  606. (when (and parent-target
  607. (or (eq new-nodes t)
  608. (and (eq new-nodes 'confirm)
  609. (y-or-n-p (format "Create new node \"%s\"? "
  610. child)))))
  611. (org-refile-new-child parent-target child)))
  612. (user-error "Invalid target location")))))
  613. (defun org-refile-check-position (refile-pointer)
  614. "Check if the refile pointer matches the headline to which it points."
  615. (let* ((file (nth 1 refile-pointer))
  616. (re (nth 2 refile-pointer))
  617. (pos (nth 3 refile-pointer))
  618. buffer)
  619. (if (and (not (markerp pos)) (not file))
  620. (user-error "Please indicate a target file in the refile path")
  621. (when (org-string-nw-p re)
  622. (setq buffer (if (markerp pos)
  623. (marker-buffer pos)
  624. (or (find-buffer-visiting file)
  625. (find-file-noselect file))))
  626. (with-current-buffer buffer
  627. (org-with-wide-buffer
  628. (goto-char pos)
  629. (beginning-of-line 1)
  630. (unless (looking-at-p re)
  631. (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
  632. (defun org-refile-new-child (parent-target child)
  633. "Use refile target PARENT-TARGET to add new CHILD below it."
  634. (unless parent-target
  635. (error "Cannot find parent for new node"))
  636. (let ((file (nth 1 parent-target))
  637. (pos (nth 3 parent-target))
  638. level)
  639. (with-current-buffer (or (find-buffer-visiting file)
  640. (find-file-noselect file))
  641. (org-with-wide-buffer
  642. (if pos
  643. (goto-char pos)
  644. (goto-char (point-max))
  645. (unless (bolp) (newline)))
  646. (when (looking-at org-outline-regexp)
  647. (setq level (funcall outline-level))
  648. (org-end-of-subtree t t))
  649. (org-back-over-empty-lines)
  650. (insert "\n" (make-string
  651. (if pos (org-get-valid-level level 1) 1) ?*)
  652. " " child "\n")
  653. (beginning-of-line 0)
  654. (list (concat (car parent-target) "/" child) file "" (point))))))
  655. (defun org-olpath-completing-read (prompt collection &rest args)
  656. "Read an outline path like a file name."
  657. (let ((thetable collection))
  658. (apply #'completing-read
  659. prompt
  660. (lambda (string predicate &optional flag)
  661. (cond
  662. ((eq flag nil) (try-completion string thetable))
  663. ((eq flag t)
  664. (let ((l (length string)))
  665. (mapcar (lambda (x)
  666. (let ((r (substring x l))
  667. (f (if (string-match " ([^)]*)$" x)
  668. (match-string 0 x)
  669. "")))
  670. (if (string-match "/" r)
  671. (concat string (substring r 0 (match-end 0)) f)
  672. x)))
  673. (all-completions string thetable predicate))))
  674. ;; Exact match?
  675. ((eq flag 'lambda) (assoc string thetable))))
  676. args)))
  677. (provide 'org-refile)
  678. ;; Local variables:
  679. ;; generated-autoload-file: "org-loaddefs.el"
  680. ;; End:
  681. ;;; org-refile.el ends here