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