Function: org-agenda-bulk-action
org-agenda-bulk-action is an interactive and byte-compiled function
defined in org-agenda.el.gz.
Signature
(org-agenda-bulk-action &optional ARG)
Documentation
Execute an remote-editing action on all marked entries.
The prefix arg is passed through to the command if possible.
Key Bindings
Source Code
;; Defined in /usr/src/emacs/lisp/org/org-agenda.el.gz
(defun org-agenda-bulk-action (&optional arg)
"Execute an remote-editing action on all marked entries.
The prefix arg is passed through to the command if possible."
(interactive "P")
;; When there is no mark, act on the agenda entry at point.
(if (not org-agenda-bulk-marked-entries)
(save-excursion (org-agenda-bulk-mark)))
(dolist (m org-agenda-bulk-marked-entries)
(unless (and (markerp m)
(marker-buffer m)
(buffer-live-p (marker-buffer m))
(marker-position m))
(user-error "Marker %s for bulk command is invalid" m)))
;; Prompt for the bulk command.
(org-unlogged-message
(concat "Bulk (" (if org-agenda-persistent-marks "" "don't ") "[p]ersist marks): "
"[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
"[S]catter [f]unction "
(and org-agenda-bulk-custom-functions
(format " Custom: [%s]"
(mapconcat (lambda (f) (char-to-string (car f)))
org-agenda-bulk-custom-functions
"")))))
(catch 'exit
(let* ((org-log-refile (if org-log-refile 'time nil))
(entries (reverse org-agenda-bulk-marked-entries))
(org-overriding-default-time
(and (get-text-property (point) 'org-agenda-date-header)
(org-get-cursor-date)))
redo-at-end
cmd)
(pcase (read-char-exclusive)
(?p
(let ((org-agenda-persistent-marks
(not org-agenda-persistent-marks)))
(org-agenda-bulk-action)
(throw 'exit nil)))
(?$
(setq cmd #'org-agenda-archive))
(?A
(setq cmd #'org-agenda-archive-to-archive-sibling))
((or ?r ?w)
(let ((refile-location
(org-refile-get-location
"Refile to"
(marker-buffer (car entries))
org-refile-allow-creating-parent-nodes)))
(when (nth 3 refile-location)
(setcar (nthcdr 3 refile-location)
(move-marker
(make-marker)
(nth 3 refile-location)
(or (get-file-buffer (nth 1 refile-location))
(find-buffer-visiting (nth 1 refile-location))
(error "This should not happen")))))
(setq cmd (lambda () (org-agenda-refile nil refile-location t)))
(setq redo-at-end t)))
(?t
(let ((state (completing-read
"Todo state: "
(with-current-buffer (marker-buffer (car entries))
(mapcar #'list org-todo-keywords-1)))))
(setq cmd (lambda ()
(let ((org-inhibit-blocking t)
(org-inhibit-logging 'note))
(org-agenda-todo state))))))
((and (or ?- ?+) action)
(let ((tag (completing-read
(format "Tag to %s: " (if (eq action ?+) "add" "remove"))
(with-current-buffer (marker-buffer (car entries))
(delq nil
(mapcar (lambda (x) (and (stringp (car x)) x))
org-current-tag-alist))))))
(setq cmd
(lambda ()
(org-agenda-set-tags tag
(if (eq action ?+) 'on 'off))))))
((and (or ?s ?d) c)
(let* ((schedule? (eq c ?s))
(prompt (if schedule? "(Re)Schedule to" "(Re)Set Deadline to"))
(time
(and (not arg)
(let ((new (org-read-date
nil nil nil prompt org-overriding-default-time)))
;; A "double plus" answer applies to every
;; scheduled time. Do not turn it into
;; a fixed date yet.
(if (string-match-p "\\`[ \t]*\\+\\+"
org-read-date-final-answer)
org-read-date-final-answer
new)))))
;; Make sure to not prompt for a note when bulk
;; rescheduling/resetting deadline as Org cannot cope with
;; simultaneous notes. Besides, it could be annoying
;; depending on the number of marked items.
(setq cmd
(if schedule?
(lambda ()
(let ((org-log-reschedule
(and org-log-reschedule 'time)))
(org-agenda-schedule arg time)))
(lambda ()
(let ((org-log-redeadline (and org-log-redeadline 'time)))
(org-agenda-deadline arg time)))))))
(?S
(unless (org-agenda-check-type nil 'agenda 'todo)
(user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type))
(let ((days (read-number
(format "Scatter tasks across how many %sdays: "
(if arg "week" ""))
7)))
(setq cmd
(lambda ()
(let ((distance (1+ (random days))))
(when arg
(let ((dist distance)
(day-of-week
(calendar-day-of-week
(calendar-gregorian-from-absolute (org-today)))))
(dotimes (_ (1+ dist))
(while (member day-of-week org-agenda-weekend-days)
(cl-incf distance)
(cl-incf day-of-week)
(when (= day-of-week 7)
(setq day-of-week 0)))
(cl-incf day-of-week)
(when (= day-of-week 7)
(setq day-of-week 0)))))
;; Silently fail when try to replan a sexp entry.
(ignore-errors
(let* ((date (calendar-gregorian-from-absolute
(+ (org-today) distance)))
(time (org-encode-time
0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(org-agenda-schedule nil time))))))))
(?f
(setq cmd
(intern
(completing-read "Function: " obarray #'fboundp t nil nil))))
(action
(setq cmd
(pcase (assoc action org-agenda-bulk-custom-functions)
(`(,_ ,fn)
fn)
(`(,_ ,fn ,arg-fn)
(apply #'apply-partially fn (funcall arg-fn)))
(_
(user-error "Invalid bulk action: %c" action))))
(setq redo-at-end t)))
;; Sort the markers, to make sure that parents are handled
;; before children.
(setq entries (sort entries
(lambda (a b)
(cond
((eq (marker-buffer a) (marker-buffer b))
(< (marker-position a) (marker-position b)))
(t
(string< (buffer-name (marker-buffer a))
(buffer-name (marker-buffer b))))))))
;; Now loop over all markers and apply CMD.
(let ((processed 0)
(skipped 0))
(dolist (e entries)
(let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e)))
(if (not pos)
(progn (message "Skipping removed entry at %s" e)
(cl-incf skipped))
(goto-char pos)
(let (org-loop-over-headlines-in-active-region) (funcall cmd))
;; `post-command-hook' is not run yet. We make sure any
;; pending log note is processed.
(when org-log-setup (org-add-log-note))
(cl-incf processed))))
(when redo-at-end (org-agenda-redo))
(unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
(message "Acted on %d entries%s%s"
processed
(if (= skipped 0)
""
(format ", skipped %d (disappeared before their turn)"
skipped))
(if (not org-agenda-persistent-marks) "" " (kept marked)"))))))