org-refile.el 32 KB

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